i am using Visual Studio .NET (VB)
So if you have a solution in C#, just go here first (http://converter.telerik.com/)
I have a document with text, and an array of words to replace:
I need to replace the plaintext and substitute with actual mergefield
Dim replacements(,) As String =
New String(,) {{"[firstname]", "$Field.FName"},
{"[lastname]", "$Field.LName"},
{"[addr]", "$Field.Addr.St"},
{"[city]", "$Field.City"}}
Dim dotXLoc "c:/test/result.dotx"
Dim Fileformat As Microsoft.Office.Interop.Word.WdSaveFormat = Word.WdSaveFormat.wdFormatXMLTemplate 'SAVE AS DOT
Dim wordApp As Object = New Microsoft.Office.Interop.Word.Application()
Dim currentDoc As Microsoft.Office.Interop.Word.Document = wordApp.Documents.Open(dotXLoc)
' Get bounds of the array.
Dim bound0 As Integer = replacements.GetUpperBound(0)
' Loop over all elements.
For i As Integer = 0 To bound0
' Get element.
Dim FieldFind As String = replacements(i, 0)
Dim FieldReplace As String = replacements(i, 1)
'<<< CODE HERE TO REPLACE TEXT WITH MERGEFIELD >>>
Next
currentDoc.SaveAs(dotXLoc & " v2.dotx", Fileformat)
currentDoc.Close()
wordApp.Quit()
Here is the end result
Public sub main()
Dim rtfLoc = "c:/temp.rtf"
Dim dotXLoc = "c:/temp.dotx"
Dim Fileformat As Microsoft.Office.Interop.Word.WdSaveFormat = Word.WdSaveFormat.wdFormatXMLTemplate
Dim wordApp As Word.Application = New Microsoft.Office.Interop.Word.Application()
Dim currentDoc As Microsoft.Office.Interop.Word.Document = wordApp.Documents.Open(rtfLoc)
TextToMergeField(currentDoc)
currentDoc.SaveAs(dotXLoc, Fileformat)
currentDoc.Close()
wordApp.Quit()
End Sub
we call TextToMergeField(currentDoc) from the main function
this way we can loop through multiple documents and replace all instances
Private Sub TextToMergeField(ByRef currentdoc As Word.Document)
Dim rng As Word.Range
Dim replacements(,) As String =
New String(,) {{"[firstname]", "$Field.FName"},
{"[lastname]", "$Field.LName"},
{"[addr]", "$Field.Addr.St"},
{"[city]", "$Field.City"}}
Dim bound0 As Integer = replacements.GetUpperBound(0)
currentdoc.Activate()
For i As Integer = 0 To bound0
rng = currentdoc.Range
With rng.Find
.Text = replacements(i, 0)
Do While .Execute(Replace:=WdReplace.wdReplaceOne)
currentdoc.Fields.Add(rng, WdFieldType.wdFieldMergeField, replacements(i, 1))
Loop
End With
Next
End Sub
Hope this helps someone
Related
I am new to this forum and hoping to get some help.
I have a an HTML string having text and several base64 images.
I need to loop through all image tags adding a slash / before
the closing tag > so that each image ends with /> and return
a new html string with the changes.
so each
<IMG src="data:image/png;base64,iVBORw0KG....">
should then be
<IMG src="data:image/png;base64,iVBORw0KG...."/>
I am not versed with html and I am wondering how to do it
(using regex?).
Here is some pseudo code:
Function GetSourceImges(Sourcehtml As String) As List(Of String)
Dim listOfImgs As New List(Of String)()
'use regex to find image tags
'Return list of base64 image tags
End Function
For each image in list
insert a slash appropriately
next
Reconstitute a new html string with edited images
Thanks
Map all "IMG" tags using LINQ and use their indexes as an anchor to fix the missing "/" characters. please see my comments inside the code.
Sub Main()
Dim htmlstring As String = "<IMG src=""data:image/png;base64,iVBORw0KG....""> " & vbCrLf _
& "<img src=""data:image/png;base64,iVBORw0KG...."">" & vbCrLf _
& "<p>blahblah</p>" & vbCrLf _
& "<IMG src=""data:image/png;base64,iVBORw0KG...."">" & vbCrLf _
& "<p>blahblah</p>"
' find all indxes of img using regex and lambda exprations '
Dim indexofIMG() As Integer = Regex.Matches(htmlstring, "IMG", RegexOptions.IgnoreCase) _
.Cast(Of Match)().Select(Function(x) x.Index).ToArray()
' check from each index of "IMG" if "/" is missing '
For Each itm As Integer In indexofIMG
Dim counter As Integer = itm
While counter < htmlstring.Length - 1
If htmlstring(counter) = ">" Then
If htmlstring(counter - 1) <> "/" Then
' fix the missing "/" using Insert() method '
htmlstring = htmlstring.Insert(counter, "/")
End If
Exit While
End If
counter += 1
End While
Next
Console.WriteLine(htmlstring)
Console.ReadLine()
End Sub
Surprisingly it works with the console app but doesn't when I view it on a richtextbox as in btnEditHTML method below. The generated pdf has only one red dot and not two.
Can't say why.
I must say you have been very helpfull.
'SetTable and customimagetagprocessor borrowed from [here] iTextsharp base64 embedded image in header not parsing/showing
Imports System.IO
Imports iTextSharp.text
Imports iTextSharp.tool.xml
Imports iTextSharp.text.pdf
Imports iTextSharp.tool.xml.parser
Imports iTextSharp.tool.xml.pipeline.css
Imports iTextSharp.tool.xml.pipeline.html
Imports iTextSharp.tool.xml.pipeline.end
Imports iTextSharp.tool.xml.html
Imports System.Text.RegularExpressions
Public Class Form1
Dim dsktop As String = My.Computer.FileSystem.SpecialDirectories.Desktop
Public Function GetFormattedHTML(str As String) As String
'format images by changing > to />
' find all indxes of img using regex and lambda exprations '
Dim indexofIMG() As Integer = Regex.Matches(str.ToString, "IMG", RegexOptions.IgnoreCase) _
.Cast(Of Match)().Select(Function(x) x.Index).ToArray()
' check from each index of "IMG" if "/" is missing '
For Each itm As Integer In indexofIMG
Dim counter As Integer = itm
While counter < str.ToString.Length - 1
If str(counter) = ">" Then
If str(counter - 1) <> "/" Then
' fix the missing "/" using Insert() method '
str = str.ToString.Insert(counter, " /")
End If
Exit While
End If
counter += 1
End While
Next
Return str.ToString
End Function
Private Sub btnEditHTML_Click(sender As Object, e As EventArgs) Handles btnEditHTML.Click
Rtb.Text = String.Empty
'the 2 base64 images in the html below are actually just small red dots
Dim RawHTML As String = "<P>John Doe</P><IMG " &
"src=""data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAEAAAABCAYAAAAfFcSJAAAADUlEQVR42mP8z8BQDwAEhQGAhKmMIQAAAABJRU5ErkJggg==""> Jackson5<IMG " &
"src=""data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAEAAAABCAYAAAAfFcSJAAAADUlEQVR42mP8z8BQDwAEhQGAhKmMIQAAAABJRU5ErkJggg=="">"
Rtb.Text = GetFormattedHTML(RawHTML)
'notice that the 2nd base64 string is not edited as required.
End Sub
Private Sub btnGenerate_Click(sender As Object, e As EventArgs) Handles btnGenerate.Click
'here I create a 2 column itextsharp table to parse my html into the cells
Dim doc As New iTextSharp.text.Document(iTextSharp.text.PageSize.A4, 25, 25, 25, 30)
Dim wri As PdfWriter = PdfWriter.GetInstance(doc, New System.IO.FileStream(dsktop & "\testtable.pdf", System.IO.FileMode.Create))
doc.Open()
'set table columnwidths -------------------------------------------------------------
Dim MainTable As New PdfPTable(2) '2 column table
MainTable.WidthPercentage = 100
Dim Wth(1) As Single
Dim u As Integer = 2
For i As Integer = 0 To 1
Wth(i) = CInt(Math.Floor(2 * 500 / u))
Next
MainTable.SetWidths(Wth)
Dim htmlstr As String = GetFormattedHTML("<P>John Doe</P><IMG " &
"src=""data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAEAAAABCAYAAAAfFcSJAAAADUlEQVR42mP8z8BQDwAEhQGAhKmMIQAAAABJRU5ErkJggg==""> Jackson5<IMG " &
"src=""data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAEAAAABCAYAAAAfFcSJAAAADUlEQVR42mP8z8BQDwAEhQGAhKmMIQAAAABJRU5ErkJggg=="">")
Dim Elmts = New ElementList()
Elmts = XMLWorkerHelper.ParseToElementList(htmlstr, Nothing)
Dim MinorTable As New PdfPTable(1)
MinorTable = SetTable(Elmts, htmlstr)
For i = 1 To 2
Dim Cell As New PdfPCell
Cell.AddElement(MinorTable)
MainTable.AddCell(Cell)
Next
doc.Add(MainTable)
doc.Close()
Process.Start(dsktop & "\testtable.pdf")
End Sub
Public Function SetTable(ByVal elements As ElementList, ByVal htmlcode As String) As PdfPTable
Dim tagProcessors As DefaultTagProcessorFactory = CType(Tags.GetHtmlTagProcessorFactory(), DefaultTagProcessorFactory)
tagProcessors.RemoveProcessor(HTML.Tag.IMG) ' remove the default processor
tagProcessors.AddProcessor(HTML.Tag.IMG, New CustomImageTagProcessor()) ' use our new processor
Dim cssResolver As ICSSResolver = XMLWorkerHelper.GetInstance().GetDefaultCssResolver(True)
cssResolver.AddCssFile(Application.StartupPath & "\pdf.css", True)
'see sample css file at https://learnwebcode.com/how-to-create-your-first-css-file/
'Setup Fonts
Dim xmlFontProvider As XMLWorkerFontProvider = New XMLWorkerFontProvider(XMLWorkerFontProvider.DONTLOOKFORFONTS)
xmlFontProvider.RegisterDirectory(Path.Combine(AppDomain.CurrentDomain.BaseDirectory, "assets/fonts/"))
Dim cssAppliers As CssAppliers = New CssAppliersImpl(xmlFontProvider)
Dim htmlContext As HtmlPipelineContext = New HtmlPipelineContext(cssAppliers)
htmlContext.SetAcceptUnknown(True)
htmlContext.SetTagFactory(tagProcessors)
Dim pdf As ElementHandlerPipeline = New ElementHandlerPipeline(elements, Nothing)
Dim htmlp As HtmlPipeline = New HtmlPipeline(htmlContext, pdf)
Dim css As CssResolverPipeline = New CssResolverPipeline(cssResolver, htmlp)
Dim worker As XMLWorker = New XMLWorker(css, True)
Dim p As XMLParser = New XMLParser(worker)
'Dim holderTable As New PdfPTable({1})
Dim holderTable As PdfPTable = New PdfPTable({1})
holderTable.WidthPercentage = 100
holderTable.HorizontalAlignment = Element.ALIGN_LEFT
Dim holderCell As New PdfPCell()
holderCell.Padding = 0
holderCell.UseBorderPadding = False
holderCell.Border = 0
p.Parse(New MemoryStream(System.Text.Encoding.ASCII.GetBytes(htmlcode)))
For Each el As IElement In elements
holderCell.AddElement(el)
Next
holderTable.AddCell(holderCell)
'Dim holderRow As New PdfPRow({holderCell})
'holderTable.Rows.Add(holderRow)
Return holderTable
End Function
End Class
Public Class CustomImageTagProcessor
Inherits iTextSharp.tool.xml.html.Image
Public Overrides Function [End](ctx As IWorkerContext, tag As Tag, currentContent As IList(Of IElement)) As IList(Of IElement)
Dim attributes As IDictionary(Of String, String) = tag.Attributes
Dim src As String = String.Empty
If Not attributes.TryGetValue(iTextSharp.tool.xml.html.HTML.Attribute.SRC, src) Then
Return New List(Of IElement)(1)
End If
If String.IsNullOrEmpty(src) Then
Return New List(Of IElement)(1)
End If
If src.StartsWith("data:image/", StringComparison.InvariantCultureIgnoreCase) Then
' data:[<MIME-type>][;charset=<encoding>][;base64],<data>
Dim base64Data As String = src.Substring(src.IndexOf(",") + 1)
Dim imagedata As Byte() = Convert.FromBase64String(base64Data)
Dim image As iTextSharp.text.Image = iTextSharp.text.Image.GetInstance(imagedata)
Dim list As List(Of IElement) = New List(Of IElement)()
Dim htmlPipelineContext As pipeline.html.HtmlPipelineContext = GetHtmlPipelineContext(ctx)
list.Add(GetCssAppliers().Apply(New Chunk(DirectCast(GetCssAppliers().Apply(image, tag, htmlPipelineContext), iTextSharp.text.Image), 0, 0, True), tag, htmlPipelineContext))
Return list
Else
If File.Exists(Path.Combine(AppDomain.CurrentDomain.BaseDirectory, src)) Then
Dim imagedata As Byte() = File.ReadAllBytes(Path.Combine(AppDomain.CurrentDomain.BaseDirectory, src))
Dim image As iTextSharp.text.Image = iTextSharp.text.Image.GetInstance(Path.Combine(AppDomain.CurrentDomain.BaseDirectory, src))
Dim list As List(Of IElement) = New List(Of IElement)()
Dim htmlPipelineContext As pipeline.html.HtmlPipelineContext = GetHtmlPipelineContext(ctx)
list.Add(GetCssAppliers().Apply(New Chunk(DirectCast(GetCssAppliers().Apply(image, tag, htmlPipelineContext), iTextSharp.text.Image), 0, 0, True), tag, htmlPipelineContext))
Return list
End If
Return MyBase.[End](ctx, tag, currentContent)
End If
End Function
End Class
I highly recommend just using AngleSharp to parse the HTML, edit the document if required, and save it again.
There are many posts on here about why trying to parse HTML with regular expressions is a bad idea.
var doc = new HtmlParser().Parse(html);
As you aren't actually changing the HTML content, just fixing up the tags, your should be able to just parse it and save it with no changes to fix the tags.
hi firends i have started with sap b1 i created my own add-on sap using c# in visual studio 2010 my form will sent a value to my crystal report directly without showing previou any one can help my version sap is 9.2
i tried this code but it doesn't work
//add crystalreport to my add-on
SAPbobsCOM.ReportTypesService rptTypeService = (SAPbobsCOM.ReportTypesService)
Menu.company.GetCompanyService().GetBusinessService(SAPbobsCOM.ServiceTypes.ReportTypesService);
SAPbobsCOM.ReportType newType = (SAPbobsCOM.ReportType)
rptTypeService.GetDataInterface(SAPbobsCOM.ReportTypesServiceDataInterfaces.rtsReportType);
newType.TypeName = "CodeBarre_etat";
newType.AddonName = "PRINT_CODEBARRE";
newType.AddonFormType = "PRINT_CODEBARRE";
newType.MenuID = "PRINT_CODEBARRE";
SAPbobsCOM.ReportTypeParams newTypeParam = rptTypeService.AddReportType(newType);
//add layout to my report
SAPbobsCOM.ReportLayoutsService rptService = (SAPbobsCOM.ReportLayoutsService)
Menu.company.GetCompanyService().GetBusinessService(SAPbobsCOM.ServiceTypes.ReportLayoutsService);
SAPbobsCOM.ReportLayout newReport = (SAPbobsCOM.ReportLayout)
rptService.GetDataInterface(SAPbobsCOM.ReportLayoutsServiceDataInterfaces.rlsdiReportLayout);
newReport.Author = Menu.company.UserName;
newReport.Category = SAPbobsCOM.ReportLayoutCategoryEnum.rlcCrystal;
newReport.Name = "PRINT_CODEBARREL";
newReport.TypeCode = newTypeParam.TypeCode;
SAPbobsCOM.ReportLayoutParams newReportParam = rptService.AddReportLayout(newReport);
// Set the report layout into the report type.
newType = rptTypeService.GetReportType(newTypeParam);
newType.DefaultReportLayout = newReportParam.LayoutCode;
rptTypeService.UpdateReportType(newType);
SAPbobsCOM.BlobParams oBlobParams = (SAPbobsCOM.BlobParams)
Menu. company.GetCompanyService().GetDataInterface(SAPbobsCOM.CompanyServiceDataInterfaces.csdiBlobParams);
oBlobParams.Table = "OITM";
oBlobParams.Field = "Template";
SAPbobsCOM.BlobTableKeySegment oKeySegment = oBlobParams.BlobTableKeySegments.Add();
oKeySegment.Name = "ItemCode";
oKeySegment.Value = newReportParam.LayoutCode;
FileStream oFile = new FileStream("CodeBarre_etat.rpt", System.IO.FileMode.Open);
int fileSize = (int)oFile.Length;
byte[] buf = new byte[fileSize];
oFile.Read(buf, 0, fileSize);
oFile.Dispose();
//SAPbobsCOM.Blob oBlob = (SAPbobsCOM.Blob)
//Menu.company.GetCompanyService().GetDataInterface(SAPbobsCOM.CompanyServiceDataInterfaces.csdiBlob);
SAPbobsCOM.Blob oBlob = (SAPbobsCOM.Blob)(Menu.company.GetCompanyService().GetDataInterface(SAPbobsCOM.CompanyServiceDataInterfaces.csdiBlob));
oBlob.Content = Convert.ToBase64String(buf, 0, fileSize);
Menu.company.GetCompanyService().SetBlob(oBlobParams, oBlob);
Not sure what the issue might be with your code, but below is a working implementation of what you're trying to do (albeit in VB, not in C#, but translating it should be fairly trivial).
Here's a sample call:
setCrystalReport(REPORT_TITLE_SUMMARY, My.Settings.ReportsPath.TrimEnd("\") & "\" & "comm_report_summary.rpt", _
oForm, "myFormTypeID", "My Add-On Name", "MENU_ID_VALUE")
Function:
'Returns new CR TypeCode
Private Function setCrystalReport(ByVal rptName As String, ByVal rptPath As String, ByRef oForm As SAPbouiCOM.Form, ByVal formType As String, _
ByVal addOnName As String, ByVal menuID As String) As String
Try
'1. Ad a new report type => ReportTypesService (8.81+ only)
Dim rptTypeService As SAPbobsCOM.ReportTypesService
Dim newType As SAPbobsCOM.ReportType
rptTypeService = SBO_Company.GetCompanyService().GetBusinessService(SAPbobsCOM.ServiceTypes.ReportTypesService)
newType = rptTypeService.GetDataInterface(SAPbobsCOM.ReportTypesServiceDataInterfaces.rtsReportType)
newType.TypeName = rptName
newType.AddonName = addOnName
newType.AddonFormType = formType
newType.MenuID = menuID
Dim newTypeParam As SAPbobsCOM.ReportTypeParams
newTypeParam = rptTypeService.AddReportType(newType)
'2. Add a new report layout => ReportLayoutService
Dim rptService As SAPbobsCOM.ReportLayoutsService
Dim newReport As SAPbobsCOM.ReportLayout
rptService = SBO_Company.GetCompanyService().GetBusinessService(SAPbobsCOM.ServiceTypes.ReportLayoutsService)
newReport = rptService.GetDataInterface(SAPbobsCOM.ReportLayoutsServiceDataInterfaces.rlsdiReportLayout)
newReport.Author = SBO_Company.UserName
newReport.Category = SAPbobsCOM.ReportLayoutCategoryEnum.rlcCrystal
newReport.Name = rptName
newReport.TypeCode = newTypeParam.TypeCode
Dim newReportParam As SAPbobsCOM.ReportLayoutParams
newReportParam = rptService.AddReportLayout(newReport)
'3. Set the report layout into the report type
newType = rptTypeService.GetReportType(newTypeParam)
newType.DefaultReportLayout = newReportParam.LayoutCode
rptTypeService.UpdateReportType(newType)
'4. Link the Report layout code to the Crystal Report file
Dim oBlobParams As SAPbobsCOM.BlobParams
Dim oKeySegment As SAPbobsCOM.BlobTableKeySegment
oBlobParams = SBO_Company.GetCompanyService().GetDataInterface(SAPbobsCOM.CompanyServiceDataInterfaces.csdiBlobParams)
oBlobParams.Table = "RDOC"
oBlobParams.Field = "Template"
oKeySegment = oBlobParams.BlobTableKeySegments.Add()
oKeySegment.Name = "DocCode"
oKeySegment.Value = newReportParam.LayoutCode
Dim oFile As New FileStream(rptPath, System.IO.FileMode.Open)
Dim fileSize As Integer
fileSize = oFile.Length
Dim buf(fileSize) As Byte
oFile.Read(buf, 0, fileSize)
oFile.Dispose()
Dim oBlob As SAPbobsCOM.Blob
oBlob = SBO_Company.GetCompanyService().GetDataInterface(SAPbobsCOM.CompanyServiceDataInterfaces.csdiBlob)
oBlob.Content = Convert.ToBase64String(buf, 0, fileSize)
SBO_Company.GetCompanyService().SetBlob(oBlobParams, oBlob)
'5. Link the new report type to your form
Return newType.TypeCode
Catch ex As Exception
Dim exString As String = ""
exString = "Exception caught in setCrystalReport Method. Details: " & ex.Message
If Not ex.InnerException Is Nothing Then
exString += " Inner Exception: " + ex.InnerException.Message
End If
SBO_Application.StatusBar.SetText(exString, SAPbouiCOM.BoMessageTime.bmt_Medium, _
SAPbouiCOM.BoStatusBarMessageType.smt_Error)
Return "-1"
End Try
End Function
I am trying to open a excel file in vb.net with excel interop
then add a formula to F2 then save as excel as csv
Can someone point me how to concatenate an ' with number in a formula cs when i write ' the Visual studio consider it as a comment not a formula
Private Sub Button3_Click(sender As Object, e As EventArgs) Handles Button3.Click
Dim newFileName As String = "Libanpost" + Date.Today.ToString("ddMMyyyy") + ".csv"
Dim oExcelFile As Object
Try
oExcelFile = GetObject("c:\database", "Excel.Application")
Catch
oExcelFile = CreateObject("Excel.Application")
End Try
oExcelFile.Visible = True
Dim strfilename As String = "Libanpost" + Date.Today.ToString("ddMMyyyy") + ".xls"
Dim strFolderPath As String = "c:\database"
oExcelFile.Workbooks.Open(strFolderPath + "\" + strfilename)
Dim oExcelsheet As Excel.Worksheet
oExcelsheet = oExcelFile.sheets("table1")
oExcelsheet.Range("f1").Value = "CRC"
oExcelsheet.Range("f2").Formula = " = IF(LEN(A2)=2,(CONCATENATE("'00000",A2)),IF(LEN(A2)=3,CONCATENATE("'0000",A2),IF(LEN(A2)=4,CONCATENATE("'000",A2),IF(LEN(A2)=5,CONCATENATE("'00",A2),IF(LEN(A2)=6,CONCATENATE("'0",A2),A2)))))"
oExcelFile.DisplayAlerts = False
oExcelFile.ActiveWorkbook.SaveAs(Filename:=strFolderPath + "\" + newFileName, FileFormat:=Excel.XlFileFormat.xlCSV, CreateBackup:=False)
oExcelFile.ActiveWorkbook.Close(SaveChanges:=False)
Dim file_count As Integer = File.ReadAllLines(strFolderPath + "\" + newFileName).Length
MsgBox(file_count)
oExcelFile.DisplayAlerts = True
oExcelFile.Quit()
oExcelFile = Nothing
The problem is that you have included double quotes (") inside your string literal. The first double quote inside the string is taken to mean the end of the string. It happens to be followed by a single quote which indicate the start of a comment. If you include a double quote inside a string literal, you need to have two of them. Here is the corrected statement (I split it over three lines for readability).
oExcelsheet.Range("f2").Formula = "=IF(LEN(A2)=2,(CONCATENATE(""'00000"",A2))," _
& "IF(LEN(A2)=3,CONCATENATE(""'0000"",A2),IF(LEN(A2)=4,CONCATENATE(""'000"",A2)," _
& "IF(LEN(A2)=5,CONCATENATE(""'00"",A2),IF(LEN(A2)=6,CONCATENATE(""'0"",A2),A2)))))"
I've created an application in .net to monitor jobs in the printer by using the DLL in the following reference :
http://www.codeproject.com/Articles/51085/Monitor-jobs-in-a-printer-queue-NET?fid=1556859&select=4799234
my question is : how can i delay or prevent user from printing after he print for example 5 times a day ?
Knowing that The print jobs will saved in the DB.
I appreciate any help.
A fairly simply program could be written using the FindFirstPrinterChangeNotification function that monitors all printers available to the user. It should watch for the PRINTER_CHANGE_ADD_JOB event, which indicates a print job has been started. Once the user has exceeded the criteria, your program would then delete any new print jobs the user started. I think it would be best to notify the user rather than just deleting their print jobs silently.
This doesn't prevent users from trying to print, but it does have the same end result. No paper will be produced until your application allows it.
Solved ! I've used the following methods to solve my problem :
to pause printer Job call this :
Public Shared Function PausePrintJob(printerName As String, printJobID As Integer) As Boolean
Dim isActionPerformed As Boolean = False
Dim searchQuery As String = "SELECT * FROM Win32_PrintJob"
Dim searchPrintJobs As New ManagementObjectSearcher(searchQuery)
Dim prntJobCollection As ManagementObjectCollection = searchPrintJobs.[Get]()
For Each prntJob As ManagementObject In prntJobCollection
Dim jobName As System.String = prntJob.Properties("Name").Value.ToString()
Dim splitArr As Char() = New Char(0) {}
splitArr(0) = Convert.ToChar(",")
Dim prnterName As String = jobName.Split(splitArr)(0)
Dim prntJobID As Integer = Convert.ToInt32(jobName.Split(splitArr)(1))
Dim documentName As String = prntJob.Properties("Document").Value.ToString()
If [String].Compare(prnterName, printerName, True) = 0 Then
If prntJobID = printJobID Then
prntJob.InvokeMethod("Pause", Nothing)
isActionPerformed = True
Exit For
End If
End If
Next
Return isActionPerformed
End Function
And to cancel printer jobs i've used the following method :
Public Shared Function CancelPrintJob(printerName As String, printJobID As Integer) As Boolean
Dim isActionPerformed As Boolean = False
Dim searchQuery As String = "SELECT * FROM Win32_PrintJob"
Dim searchPrintJobs As New ManagementObjectSearcher(searchQuery)
Dim prntJobCollection As ManagementObjectCollection = searchPrintJobs.[Get]()
For Each prntJob As ManagementObject In prntJobCollection
Dim jobName As System.String = prntJob.Properties("Name").Value.ToString()
Dim splitArr As Char() = New Char(0) {}
splitArr(0) = Convert.ToChar(",")
Dim prnterName As String = jobName.Split(splitArr)(0)
Dim prntJobID As Integer = Convert.ToInt32(jobName.Split(splitArr)(1))
Dim documentName As String = prntJob.Properties("Document").Value.ToString()
If [String].Compare(prnterName, printerName, True) = 0 Then
If prntJobID = printJobID Then
prntJob.Delete()
isActionPerformed = True
Exit For
End If
End If
Next
Return isActionPerformed
End Function
And if need to resume the printing after pause then you should use :
Public Shared Function ResumePrintJob(printerName As String, printJobID As Integer) As Boolean
Dim isActionPerformed As Boolean = False
Dim searchQuery As String = "SELECT * FROM Win32_PrintJob"
Dim searchPrintJobs As New ManagementObjectSearcher(searchQuery)
Dim prntJobCollection As ManagementObjectCollection = searchPrintJobs.[Get]()
For Each prntJob As ManagementObject In prntJobCollection
Dim jobName As System.String = prntJob.Properties("Name").Value.ToString()
Dim splitArr As Char() = New Char(0) {}
splitArr(0) = Convert.ToChar(",")
Dim prnterName As String = jobName.Split(splitArr)(0)
Dim prntJobID As Integer = Convert.ToInt32(jobName.Split(splitArr)(1))
Dim documentName As String = prntJob.Properties("Document").Value.ToString()
If [String].Compare(prnterName, printerName, True) = 0 Then
If prntJobID = printJobID Then
prntJob.InvokeMethod("Resume", Nothing)
isActionPerformed = True
Exit For
End If
End If
Next
Return isActionPerformed
End Function
I need to verify that a provided username is a Domain Administrator in c#.
Any idea's on how to do this?
You can use WindowsIdentity to get the current user.
Then create a WindowsPrincipal with the WindowsIdentity.
And check WindowsPrincipal.IsInRole(WindowsBuiltInRole.Administrator)
Hope this can help you.
EDIT : I just see the ASP tag now... This link could help you, same thing but for ASP.
Function ADUserInfo(sLogonUser, cOption)
Dim oConnection
Dim oCommand
Dim oRoot
Dim oDomain
Dim sADsPath
Dim sDomain
sDomain = Mid(sLogonUser, 1, Instr(1, sLogonUser, "\") - 1)
Set oConnection = CreateObject("ADODB.Connection")
With oConnection
.Provider = "ADsDSOObject"
.Mode = "1" 'Read
.Properties("Encrypt Password") = True
.Open "Active Directory Provider"
End With
Set oCommand = CreateObject("ADODB.Command")
oCommand.ActiveConnection = oConnection
Set oRoot = GetObject("LDAP://" & sDomain & "/rootdse")
Set oDomain = GetObject("LDAP://" & sDomain & "/" & oRoot.Get("defaultNamingContext"))
sADsPath = "<" & oDomain.ADsPath & ">"
Select Case lcase(cOption)
Case "groups"
ADUserInfo = ADUserGroups(sLogonUser, oConnection, oCommand, oRoot, oDomain, sADsPath)
Case "name"
ADUserInfo = ADUserName(sLogonUser, oConnection, oCommand, oRoot, oDomain, sADsPath)
Case "supervisor"
End Select
End Function
Function ADUserGroups(sLogonUser, oConnection, oCommand, oRoot, oDomain, sADsPath)
Dim sFilter
Dim sAttribsToReturn
Dim sDepth
Dim sDomainSID
Dim vObjectSID
Dim sObjectSID
Dim sGroupRID
Dim iPrimaryGroupID
Dim oPrimaryGroup
Dim oRS
Dim value
Dim cGroups
Dim sDomain
Dim sLogonName
sDomain = Mid(sLogonUser, 1, Instr(1, sLogonUser, "\") - 1)
sLogonName = Mid(sLogonUser, Instr(1, sLogonUser, "\") + 1)
sFilter = "(&(objectCategory=Person)(objectClass=user)(sAMAccountName=" & sLogonName & "))"
sAttribsToReturn = "memberOf,primaryGroupID,objectSID"
sDepth = "subTree"
ocommand.CommandText = sADsPath & ";" & sFilter & ";" & sAttribsToReturn & ";" & sDepth
Set oRS = ocommand.Execute
' Only one user should meet the criteria
If (oRS.RecordCount = 1) Then
' Get that user's info
For i = 0 To oRS.Fields.Count - 1
If (oRS.Fields(i).Name = "memberOf") Then
' I've never seen this field come back with more than
' ONE value, but the original code I started with
' treated the memberOf property as though it was a
' collection. So, I've left it a collection until
' I can verify it. KLW
cGroups = ""
For Each value In oRS.Fields(i).Value
cGroups = cGroups & replace(split(value,",")(0),"CN=","") & ";"
Next
ElseIf (oRS.Fields(i).Name = "primaryGroupID") Then
' need this to get the PrimaryGroup after other group membership has been obtained
' (Primary Group ID and Object SID ID needed to get the primary group)
iPrimaryGroupID = oRS.Fields(i).Value
ElseIf (oRS.Fields(i).Name = "objectSID") Then
' adVarBinary -- need this to get the PrimaryGroup.
' It is not included in the memberOf group list
vObjectSID = oRS.Fields(i).Value
sObjectSID = SDDL_SID(vObjectSID)
End If
Next
' The primary group is not included in memberOf...
' We have the SDDL form of the user's SID.
' Remove the user's RID ( the last sub authority)
' up to the "-"
'
sDomainSID = Mid(sObjectSID, 1, (InStrREV(sObjectSID,"-")))
' Build the SID of the Primary group
' from the domainSID and the Primary Group RID in
' the PrimaryGroupID.
'
sGroupRID = StrRID(iPrimaryGroupID)
sDomainSID = sDomainSID & sGroupRID
' Get the primary group
'
set oPrimaryGroup = GetObject("LDAP://" & sDomain & "/<SID=" & sDomainSID & ">")
cGroups = replace(split(oPrimaryGroup.Get("DistinguishedName"),",")(0),"CN=","") & ";" & cGroups
ADUserGroups = cGroups
End If
End Function
Function ADUserName(sLogonUser, oConnection, oCommand, oRoot, oDomain, sADsPath)
Dim sFilter
Dim sAttribsToReturn
Dim sDepth
Dim sDomainSID
Dim vObjectSID
Dim sObjectSID
Dim sGroupRID
Dim iPrimaryGroupID
Dim oPrimaryGroup
Dim oRS
Dim value
Dim sDomain
Dim sLogonName
sDomain = Mid(sLogonUser, 1, Instr(1, sLogonUser, "\") - 1)
sLogonName = Mid(sLogonUser, Instr(1, sLogonUser, "\") + 1)
sFilter = "(&(objectCategory=Person)(objectClass=user)(sAMAccountName=" & sLogonName & "))"
sAttribsToReturn = "distinguishedName"
sDepth = "subTree"
ocommand.CommandText = sADsPath & ";" & sFilter & ";" & sAttribsToReturn & ";" & sDepth
Set oRS = ocommand.Execute
' Only one user should meet the criteria
If (oRS.RecordCount = 1) Then
' Get that user's info
For i = 0 To oRS.Fields.Count - 1
If (oRS.Fields(i).Name = "distinguishedName") Then
ADUserName = replace(split(oRS.Fields(i).Value,",")(0),"CN=","")
End If
Next
End If
End Function
function SDDL_SID ( oSID )
dim IssueAuthorities(11)
Dim SubAuthorities
Dim strSDDL
Dim IssueIndex
Dim Revision
Dim i, j, k, index, p2, subtotal, dblSubAuth
IssueAuthorities(0) = "-0-0"
IssueAuthorities(1) = "-1-0"
IssueAuthorities(2) = "-2-0"
IssueAuthorities(3) = "-3-0"
IssueAuthorities(4) = "-4"
IssueAuthorities(5) = "-5"
IssueAuthorities(6) = "-?"
IssueAuthorities(7) = "-?"
IssueAuthorities(8) = "-?"
IssueAuthorities(9) = "-?"
' First byte is the revision value
'
Revision = ascb(midB(osid,1,1))
' Second byte is the number of sub authorities in the
' SID
'
SubAuthorities = CInt(ascb(midb(oSID,2,1)))
strSDDL = "S-" & Revision
IssueIndex = CInt(ascb(midb(oSID,8,1)))
strSDDL = strSDDL & IssueAuthorities(IssueIndex)
index = 9
i = index
for k = 1 to SubAuthorities
p2 = 0
subtotal = 0
for j = 1 to 4
dblSubAuth = CDbl(ascb(midb(osid,i,1))) * (2^p2)
subTotal = subTotal + dblSubAuth
p2 = p2 + 8
i = i + 1
next
' Convert the value to a string, add it to the SDDL Sid and continue
'
strSDDL = strSDDL & "-" & cstr(subTotal)
next
SDDL_SID = strSDDL
end function
function Get_HexString( oSID )
Dim outStr, i, b
outStr = ""
for i = 0 to Ubound(oSid)
b = hex(ascb(midb(oSid,i+1,1)))
if( len(b) = 1 ) then b = "0" & b
outStr = outStr & b
next
Get_HexString = outStr
end function
function StrRID( inVal )
dim dLocal
if( (inVal and &H80000000) <> 0 ) then
dLocal = CDbl((inval and &H7FFFFFFF))
dLocal = dLocal + 2^31
StrRID = cstr(dLocal)
else
StrRID = Cstr(inVal)
end if
end function