请问怎么重命名打印机?(50)

S

Soliry

Unregistered / Unconfirmed
GUEST, unregistred user!
D

de410

Unregistered / Unconfirmed
GUEST, unregistred user!
在打印机上点右键,选重命名~
 
S

Soliry

Unregistered / Unconfirmed
GUEST, unregistred user!
这样当然知道了,我是想问用delphi怎么实现,有一段VB的代码,有人可以改成delphi的吗:Option ExplicitPrivate Const SW_SHOWNO[wiki]RM[/wiki]AL As Long = 1Private Const PRINTER_LEVEL2 As Long = &H2Private Const PRINTER_LEVEL4 As Long = &H4Private Const STANDARD_RIGHTS_REQUIRED As Long = &HF0000Private Const PRINTER_ACCESS_ADMINISTER As Long = &H4Private Const PRINTER_ACCESS_USE As Long = &H8Private Type PRINTER_DEFAULTS pDatatype As String pDevMode As Long DesiredAccess As LongEnd TypePrivate Type PRINTER_INFO_2 pServerName As Long pPrinterName As Long pShareName As Long pPortName As Long pDriverName As Long pComment As Long pLocation As Long pDevMode As Long pSepFile As Long pPrintProcessor As Long pDatatype As Long pParameters As Long pSecurityDescriptor As Long Attributes As Long Priority As Long DefaultPriority As Long StartTime As Long UntilTime As Long Status As Long cJobs As Long AveragePPM As LongEnd TypePrivate Type PRINTER_INFO_4 pPrinterName As Long pServerName As Long Attributes As LongEnd TypePrivate Declare Function OpenPrinter Lib "winspool.drv" _ Alias "OpenPrinterA" _ (ByVal pPrinterName As String, _ phPrinter As Long, _ pDefault As Any) As Long Private Declare Function ClosePrinter Lib "winspool.drv" _ (ByVal hPrinter As Long) As Long Private Declare Function GetPrinter Lib "winspool.drv" _ Alias "GetPrinterA" _ (ByVal hPrinter As Long, _ ByVal Level As Long, _ pPrinter As Any, _ ByVal cbBuf As Long, _ pcbNeeded As Long) As Long Private Declare Function SetPrinter Lib "winspool.drv" _ Alias "SetPrinterA" _ (ByVal hPrinter As Long, _ ByVal Level As Long, _ pPrinter As Any, _ ByVal Command As Long) As LongPrivate Declare Sub CopyMemory Lib "kernel32" _ Alias "RtlMoveMemory" _ (pTo As Any, uFrom As Any, _ ByVal lSize As Long)Private Declare Function ShellExecute Lib "shell32.dll" _ Alias "ShellExecuteA" _ (ByVal hwnd As Long, _ ByVal lpOperation As String, _ ByVal lpFile As String, _ ByVal lpParameters As String, _ ByVal lpDirectory As String, _ ByVal nShowCmd As Long) As LongPrivate Sub Form_Load() Command1.Caption = "Rename Printer" Command2.Caption = "Open Printers Folder" End SubPrivate Sub Command1_Click() Debug.Print RenamePrinter("AGFA-AccuSet v52.3", "AGFA-AccuSet v52.31") '改名 End SubPrivate Sub Command2_Click() '打开打印机 Dim sParams As String Dim sDirectory As String sParams = vbNullString sDirectory = vbNullString sParams = "/e,::{2227A280-3AEA-1069-A2DE-08002B30309D}" Call ShellExecute(0&, "Open", "explorer.exe", sParams, sDirectory, SW_SHOWNORMAL)End SubPrivate Function RenamePrinter(sCurrentPrinterName As String, sNewPrinterName As String) As Boolean Dim hPrinter As Long Dim cbRequired As Long Dim cbBuffer As Long Dim pi4 As PRINTER_INFO_4 Dim ptr() As PRINTER_INFO_4 Dim pd As PRINTER_DEFAULTS pd.DesiredAccess = PRINTER_ACCESS_USE Or PRINTER_ACCESS_ADMINISTER If OpenPrinter(sCurrentPrinterName, hPrinter, pd) <> 0 then
If GetPrinter(hPrinter, PRINTER_LEVEL4, 0&, 0&, cbRequired) = 0 then
If cbRequired <> 0 then
ReDim ptr((cbRequired / Len(pi4))) cbBuffer = cbRequired If GetPrinter(hPrinter, PRINTER_LEVEL4, ptr(0), cbBuffer, cbRequired) <> 0 then
CopyMemory pi4, ByVal ptr(0), Len(pi4) pi4.pPrinterName = StrPtr(StrConv(sNewPrinterName, vbFromUnicode)) CopyMemory ptr(0), pi4, Len(pi4) RenamePrinter = SetPrinter(hPrinter, PRINTER_LEVEL4, ptr(0), 0&) <> 0 End If End If End If ClosePrinter hPrinter End IfEnd Function
 
S

Soliry

Unregistered / Unconfirmed
GUEST, unregistred user!
怎么没人知道?我现在找到一个笨办法:procedure RenamePrinter(CurPrintName,NewPrintName:string);var script:TStringList;
begin
script:=TStringList.Create;
script.Add('Set objWMIService = GetObject("winmgmts://./root/cimv2")');
script.Add('Set colPrinters = objWMIService.ExecQuery _');
script.Add(' ("Select * From Win32_Printer Where DeviceID = ' + QuotedStr(CurPrintName) + '")');
script.Add('For Each objPrinter in colPrinters');
script.Add(' objPrinter.RenamePrinter("' + NewPrintName + '")');
script.Add('Next');
script.SaveToFile('c:/temp.vbs');
script.Free;
ShellExecute(0,'Open',Pchar('c:/temp.vbs'),nil,nil,SW_HIDE);
end;
这个方法确实可行,但有没有办在Delphi里面直接运行上面的脚本呀?
 
顶部