REGISTRY DE BELIRLTILEN ANAHTARIN DEGERI DEGISTIRILDINDEN HABERDAR OLMA (NOTIFY)
unit Unit2;
//unit RegMonitorThread;
interface
uses
Classes, Windows, Messages, Registry, SysUtils;
const
WM_REGCHANGE = WM_USER + 1973;
//Need to redeclare the API function - instead of BOOL is uses DWORD.
function RegNotifyChangeKeyValue(hKey: HKEY; bWatchSubtree: DWORD; dwNotifyFilter: DWORD; hEvent: THandle; fAsynchronus: DWORD): Longint; stdcall;
external 'advapi32.dll' name 'RegNotifyChangeKeyValue';
type
TChangeData = record
Key : string;
RootKey : HKey;
end;
TRegMonitorThread = class(TThread)
private
FReg: TRegistry;
FEvent: Integer;
fChangeData : TChangeData;
fKey: string;
fRootKey: HKey;
fWatchSub: boolean;
fFilter: integer;
fWnd: THandle;
procedure InitThread;
procedure SetFilter(const Value: integer);
function GetFilter: integer;
function GetChangeData: TChangeData;
public
constructor Create;
destructor Destroy; override;
property Key: string read fKey write fKey;
property RootKey: HKey read fRootKey write fRootKey;
property WatchSub: boolean read fWatchSub write fWatchSub;
property Filter: integer read GetFilter write SetFilter;
property Wnd: THandle read fWnd write fWnd;
property ChangeData : TChangeData read GetChangeData;
protected
procedure Execute; override;
end;
implementation
{ TRegMonitorThread }
constructor TRegMonitorThread.Create;
begin
// Execute won’t be called until after Resume is called.
inherited Create(True);
FReg := TRegistry.Create;
end;
destructor TRegMonitorThread.Destroy;
begin
FReg.Free;
inherited;
end;
procedure TRegMonitorThread.InitThread;
begin
FReg.RootKey := RootKey;
if not FReg.OpenKeyReadOnly(Key) then
begin
raise Exception.Create('Unable to open registry key ' + Key);
end;
FEvent := CreateEvent(nil, True, False, 'RegMonitorChange');
RegNotifyChangeKeyValue(FReg.CurrentKey, 1, Filter, FEvent, 1);
end;
procedure TRegMonitorThread.Execute;
begin
InitThread;
while not Terminated do
begin
if WaitForSingleObject(FEvent, INFINITE) = WAIT_OBJECT_0 then
begin
fChangeData.RootKey := RootKey;
fChangeData.Key := Key;
SendMessage(Wnd, WM_REGCHANGE, RootKey, LongInt(PChar(Key)));
ResetEvent(FEvent);
RegNotifyChangeKeyValue(FReg.CurrentKey, 1, Filter, FEvent, 1);
end;
end;
end;
procedure TRegMonitorThread.SetFilter(const Value: integer);
begin
if fFilter <> Value then
begin
fFilter := Value;
end;
end;
function TRegMonitorThread.GetFilter: integer;
begin
if fFilter = 0 then begin
fFilter:=
REG_NOTIFY_CHANGE_NAME or
REG_NOTIFY_CHANGE_ATTRIBUTES or
REG_NOTIFY_CHANGE_LAST_SET or
REG_NOTIFY_CHANGE_SECURITY;
end;
Result := fFilter;
end;
function TRegMonitorThread.GetChangeData: TChangeData;
begin
Result := fChangeData;
end;
end.
/////////////////// KULLANIM
uses UNIT2;
private
procedure WMREGCHANGE(var Msg : TMessage); message WM_REGCHANGE;
var
RegMonitorThread : TRegMonitorThread;
procedure TForm1.WMREGCHANGE(var Msg: TMessage);
begin
Memo1.Lines.Add('-------------------------------------------');
Memo1.Lines.Add('Registry change at ' + DateTimeToStr(Now));
Memo1.Lines.Add(IntToStr(RegMonitorThread.ChangeData.RootKey) +
' - ' + RegMonitorThread.ChangeData.Key);
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
RegMonitorThread.Terminate;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
RegMonitorThread := TRegMonitorThread.Create;
with RegMonitorThread do
begin
FreeOnTerminate:=True;
Wnd := Form1.Handle;
Key := EDIT1.TEXT;
RootKey := HKEY_CURRENT_USER;
WatchSub := True;
Resume;
end;
end;
Delphi - .....................................
REGISTRY DEGISIKLIKLERINI IZLEME (NOTIFY)
The RegMonitorThread class
unit RegMonitorThread;
interface
uses
Classes, Windows, Messages, Registry, SysUtils;
const
WM_REGCHANGE = WM_USER + 1973;
//Need to redeclare the API function - instead of BOOL is uses DWORD.
function RegNotifyChangeKeyValue(hKey: HKEY; bWatchSubtree: DWORD; dwNotifyFilter: DWORD; hEvent: THandle; fAsynchronus: DWORD): Longint; stdcall;
external 'advapi32.dll' name 'RegNotifyChangeKeyValue';
type
TChangeData = record
Key : string;
RootKey : HKey;
end;
TRegMonitorThread = class(TThread)
private
FReg: TRegistry;
FEvent: Integer;
fChangeData : TChangeData;
fKey: string;
fRootKey: HKey;
fWatchSub: boolean;
fFilter: integer;
fWnd: THandle;
procedure InitThread;
procedure SetFilter(const Value: integer);
function GetFilter: integer;
function GetChangeData: TChangeData;
public
constructor Create;
destructor Destroy; override;
property Key: string read fKey write fKey;
property RootKey: HKey read fRootKey write fRootKey;
property WatchSub: boolean read fWatchSub write fWatchSub;
property Filter: integer read GetFilter write SetFilter;
property Wnd: THandle read fWnd write fWnd;
property ChangeData : TChangeData read GetChangeData;
protected
procedure Execute; override;
end;
implementation
{ TRegMonitorThread }
constructor TRegMonitorThread.Create;
begin
// Execute won’t be called until after Resume is called.
inherited Create(True);
FReg := TRegistry.Create;
end;
destructor TRegMonitorThread.Destroy;
begin
FReg.Free;
inherited;
end;
procedure TRegMonitorThread.InitThread;
begin
FReg.RootKey := RootKey;
if not FReg.OpenKeyReadOnly(Key) then
begin
raise Exception.Create('Unable to open registry key ' + Key);
end;
FEvent := CreateEvent(nil, True, False, 'RegMonitorChange');
RegNotifyChangeKeyValue(FReg.CurrentKey, 1, Filter, FEvent, 1);
end;
procedure TRegMonitorThread.Execute;
begin
InitThread;
while not Terminated do
begin
if WaitForSingleObject(FEvent, INFINITE) = WAIT_OBJECT_0 then
begin
fChangeData.RootKey := RootKey;
fChangeData.Key := Key;
SendMessage(Wnd, WM_REGCHANGE, RootKey, LongInt(PChar(Key)));
ResetEvent(FEvent);
RegNotifyChangeKeyValue(FReg.CurrentKey, 1, Filter, FEvent, 1);
end;
end;
end;
procedure TRegMonitorThread.SetFilter(const Value: integer);
begin
if fFilter <> Value then
begin
fFilter := Value;
end;
end;
function TRegMonitorThread.GetFilter: integer;
begin
if fFilter = 0 then begin
fFilter:=
REG_NOTIFY_CHANGE_NAME or
REG_NOTIFY_CHANGE_ATTRIBUTES or
REG_NOTIFY_CHANGE_LAST_SET or
REG_NOTIFY_CHANGE_SECURITY;
end;
Result := fFilter;
end;
function TRegMonitorThread.GetChangeData: TChangeData;
begin
Result := fChangeData;
end;
end.
Sample Delphi application
//Add a TMemo component (name: Memo1) to a Delphi form (name: Form1).
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, RegMonitorThread;
type
TForm1 = class(TForm)
Memo1: TMemo;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
procedure WMREGCHANGE(var Msg : TMessage); message WM_REGCHANGE;
public
{ Public declarations }
end;
var
Form1: TForm1;
RegMonitorThread : TRegMonitorThread;
implementation
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
begin
RegMonitorThread := TRegMonitorThread.Create;
with RegMonitorThread do
begin
FreeOnTerminate:=True;
Wnd := Form1.Handle;
Key := 'SoftwareADP';
RootKey := HKEY_LOCAL_MACHINE;
WatchSub := True;
Resume;
end;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
RegMonitorThread.Terminate;
end;
procedure TForm1.WMREGCHANGE(var Msg: TMessage);
begin
Memo1.Lines.Add('-------------------------------------------');
Memo1.Lines.Add('Registry change at ' + DateTimeToStr(Now));
Memo1.Lines.Add(IntToStr(RegMonitorThread.ChangeData.RootKey) +
' - ' + RegMonitorThread.ChangeData.Key);
end;
end.
Delphi - .....................................
YAZICIDA BEKLEYEN DOKUMANLARDAN ISTENENI SIL
uses
Winspool, Printers;
function GetCurrentPrinterHandle: THandle;
var
Device, Driver, Port: array[0..255] of Char;
hDeviceMode: THandle;
begin
Printer.GetPrinter(Device, Driver, Port, hDeviceMode);
if not OpenPrinter(@Device, Result, nil) then
RaiseLastWin32Error;
end;
function SavePChar(p: PChar): PChar;
const
error: PChar = 'Nil';
begin
if not Assigned(p) then
Result := error
else
Result := p;
end;
procedure TForm1.Button2Click(Sender: TObject);
type
TJobs = array [0..1000] of JOB_INFO_1;
PJobs = ^TJobs;
var
hPrinter: THandle;
bytesNeeded, numJobs, i: Cardinal;
pJ: PJobs;
begin
hPrinter := GetCurrentPrinterHandle;
//try
EnumJobs(hPrinter, 0, 1000, 1, nil, 0, bytesNeeded,numJobs);
pJ := AllocMem(bytesNeeded);
if not EnumJobs(hPrinter, 0, 1000, 1, pJ, bytesNeeded,bytesNeeded, numJobs) then RaiseLastWin32Error;
SetJob(hPrinter,STRTOINT(EDIT1.Text),1,pJ,JOB_CONTROL_CANCEL);
{JOB_CONTROL_CANCEL Delete the print job.
JOB_CONTROL_PAUSE Pause the print job.
JOB_CONTROL_RESTART Restart the print job. A job can only be restarted if it was printing.
JOB_CONTROL_RESUME Resume a paused print job.
}
// finally
ClosePrinter(hPrinter);
// end;
end;
Delphi - .....................................
YAZICI OZELLIKLERI DIALOGUNU AC
uses WinSpool, Printers;
procedure TForm1.Button1Click(Sender: TObject);
var
MyPrinter, MyDriver, MyPort: array[0..100] of Char;
PrinterHandle, DevMode: THandle;
begin
Printer.GetPrinter(MyPrinter, MyDriver, MyPort, DevMode);
OpenPrinter(MyPrinter, PrinterHandle, nil);
PrinterProperties(Form1.Handle, PrinterHandle);
end;
Delphi - .....................................
YAZICI ADI VE DURUMU
(* Aktif yazıcı adını bulur ve yazıcıdaki dosyların adını ve durumunu belirtir.*)
uses
Winspool, Printers;
function GetCurrentPrinterHandle: THandle;
var
Device, Driver, Port: array[0..255] of Char;
hDeviceMode: THandle;
begin
Printer.GetPrinter(Device, Driver, Port, hDeviceMode);
if not OpenPrinter(@Device, Result, nil) then
RaiseLastWin32Error;
end;
function SavePChar(p: PChar): PChar;
const
error: PChar = 'Nil';
begin
if not Assigned(p) then
Result := error
else
Result := p;
end;
procedure TForm1.Button1Click(Sender: TObject);
type
TJobs = array [0..1000] of JOB_INFO_1;
PJobs = ^TJobs;
var
hPrinter: THandle;
bytesNeeded, numJobs, i: Cardinal;
pJ: PJobs;
begin
hPrinter := GetCurrentPrinterHandle;
try
EnumJobs(hPrinter, 0, 1000, 1, nil, 0, bytesNeeded,
numJobs);
pJ := AllocMem(bytesNeeded);
if not EnumJobs(hPrinter, 0, 1000, 1, pJ, bytesNeeded,
bytesNeeded, numJobs) then
RaiseLastWin32Error;
memo1.Clear;
if numJobs = 0 then
memo1.Lines.Add('No jobs in queue')
else
for i := 0 to Pred(numJobs) do
memo1.Lines.Add(Format('Printer %s, Job %s, Status (%d): %s',
[SavePChar(pJ^[i].pPrinterName), SavePChar(pJ^[i].pDocument),
pJ^[i].Status, SavePChar(pJ^[i].pStatus)]));
finally
ClosePrinter(hPrinter);
end;
end;
Delphi - .....................................
NETWOK YAZICILARINI BULMA
Find the printers for a server specific on the network
First: insert on uses the unit name "winspool" and "printers".
After this you can write this code using the windows API EnumPrinters:
The parameter psName is the server in the network and the result is TStrings.
You can use this in a combo or a listbox.
function TForm1.GetPrintServers(psName: string): TStrings;
var
lpBuffer,lpPrinterInfo: PChar;
lcCount,lcNumCount : DWord ;
liCount,liAux:integer;
lsAuxNome:TStrings;
function GetContexts ( pctipo : cardinal; ppName : PChar ):TStringlist;
var
liCont : integer;
lsNome:string;
lbPode:boolean;
begin
lbPode:=false;
Result:=TStringlist.Create;
case pcTipo of
8: lbPode :=
EnumPrinters(pctipo,ppName,1,PByte(lpBuffer),lcCount,lcCount,
lcNumCount);
16: lbPode :=
EnumPrinters(pctipo,nil,1,PByte(lpBuffer),lcCount,lcCount,
lcNumCount);
end;
if not lbPode then
Exit;
lpPrinterInfo := lpBuffer;
for licont := 0 to lcNumCount - 1 do
begin
with PPrinterInfo1(lpPrinterInfo)^ do
begin
if pcTipo = 8 then
begin
liAux:=Pos(',',pDescription);
lsNome := copy(pDescription,liAux+1,Length(pDescription));
Result.Add(lsNome);
end
else
begin
liAux := Pos(ppName,pName);
lsNome := copy(pName,liAux,Length(pName));
if lsNome = ppName then
begin
Result.Add(string(pName));
Exit;
end;
end;
end;
Inc(lpPrinterInfo, sizeof(TPrinterInfo1));
end;
end;
begin
lsAuxNome:=TStrings.Create;
lcCount := 0;
EnumPrinters(PRINTER_ENUM_REMOTE,nil,1,nil,0,lcCount,lcNumCount);
GetMem(lpBuffer,lcCount);
lsAuxNome := GetContexts(16,PChar(psName));
if lsAuxNome.Count <> 0 then
Result:=GetContexts(8,PChar(lsAuxNome.Strings[0]))
else
begin
lsAuxNome.Add('Não Encontrada');
Result:=lsAuxNome;
end;
end;
Delphi - .....................................
YAZICI MESAJLARINI YAKALAMA 2000 / XP (NOTIFY)
unit SpyPrinterMainU;
{$I JEDI.INC}
interface
uses
Windows, Messages, SysUtils,
{$IFDEF DELPHI6_UP} Variants, {$ENDIF}
Classes, Graphics, Controls, Forms,
Dialogs, ComCtrls, PBPrintersMonitorU;
Type
TForm1 = class(TForm)
ListView1: TListView;
procedure FormCreate(Sender: TObject);
private
FMonitor: TPBPrintersMonitor;
Procedure JobNotification( const jobinfo: TPBJobInformation );
public
end;
var
Form1: TForm1;
implementation
uses typinfo, printers;
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
begin
FMonitor:= TPBPrintersMonitor.Create( self );
FMonitor.OnNewJob := JobNotification;
FMonitor.OnJobChange := JobNotification;
FMonitor.OnJobComplete := JobNotification;
FMonitor.Active := true;
Align := alTop;
end;
procedure TForm1.JobNotification(const jobinfo: TPBJobInformation);
const
orientations: Array [TPrinterOrientation] Of String =
('Portrait', 'Landscape');
var
item: TListitem;
begin
listview1.Items.BeginUpdate;
Try
item:= listview1.Items.Add;
item.Caption := FormatDateTime('yyyy-mm-dd', Date );
item.SubItems.Add( FormatDateTime( 'hh:nn:ss:zzz', Time ));
item.SubItems.Add( GetEnumName( Typeinfo( TPBJobStatus), Ord( jobinfo.Status)));
item.SubItems.Add( IntToStr( jobinfo.JobID ));
item.SubItems.Add( jobinfo.Computer );
item.SubItems.Add( jobinfo.User );
item.SubItems.Add( jobinfo.PrinterName );
item.SubItems.Add( jobinfo.Document );
item.SubItems.Add( IntToStr( jobinfo.Pages ));
item.SubItems.Add( IntToStr( jobinfo.BytesPrinted ));
item.SubItems.Add( IntToStr( jobinfo.TotalPages ));
item.SubItems.Add( IntToStr( jobinfo.TotalBytes ));
item.Subitems.Add( IntToStr( jobinfo.Copies ));
item.Subitems.Add( orientations[ jobinfo.Orientation ]
);
Finally
listview1.Items.EndUpdate;
End; { Finally }
end;
end.
Delphi - .....................................
YAZICI DEGISTIRIRKEN FONT OLCEKLEMESI BOZULMASINI ENGELLEMEK
1.YOL
uses Printers;
var
MyFile: TextFile;
begin
AssignPrn(MyFile);
Rewrite(MyFile);
Printer.Canvas.Font.Name := 'Courier New';
Printer.Canvas.Font.Style := [fsBold];
Printer.Canvas.Font.PixelsPerInch:=
GetDeviceCaps(Printer.Canvas.Handle, LOGPIXELSY);
Writeln(MyFile, 'Print this text');
System.CloseFile(MyFile);
end;
2.YOL
uses Printers;
begin
Printer.BeginDoc;
Printer.Canvas.Font.Name := 'Courier New';
Printer.Canvas.Font.Style := [fsBold];
Printer.Canvas.Font.PixelsPerInch:=
GetDeviceCaps(Printer.Canvas.Handle, LOGPIXELSY);
Printer.Canvas.Textout(10, 10, 'Print this text');
Printer.EndDoc;
end;
Delphi - .....................................
YAZDIRILAN SAYFA ARALARINDA YAZICI AYARLARINI DEGISTIRME
Mevcut ayarları alır , değişiklikleri yapar ve daha sonra sayfa arasında ResetDc() Windows APIsini çağırır
unit Unit1;
interface
{$IFDEF WIN32}
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls,
Forms, Dialogs, StdCtrls, Printers;
{$ELSE}
uses
SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics,
Controls, Forms, Dialogs, StdCtrls, Printers, Print;
{$ENDIF}
type
TForm1 = class(TForm)
PrintDialog1: TPrintDialog;
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
function PageSetup : bool;
function NewPage : bool;
public
{ Public declarations }
PageNumber : integer;
CanReset : bool;
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
{$IFNDEF WIN32}
const MAX_PATH = 144;
{$ENDIF}
function TForm1.PageSetup : bool;
var
pDevice : pChar;
pDriver : pChar;
pPort : pChar;
hDMode : THandle;
PDMode : PDEVMODE;
PrnHandle : THandle;
begin
result := false;
GetMem(pDevice, cchDeviceName);
GetMem(pDriver, MAX_PATH);
GetMem(pPort, MAX_PATH);
Printer.GetPrinter(pDevice, pDriver, pPort, hDMode);
if hDMode <> 0 then begin
pDMode := GlobalLock(hDMode);
if pDMode <> nil then begin
{Change your printing settings here}
if not odd(PageNumber) then begin
pDMode^.dmFields := pDMode^.dmFields or dm_PaperSize;
pDMode^.dmPaperSize := DMPAPER_LETTER;
end else begin
pDMode^.dmFields := pDMode^.dmFields or dm_PaperSize;
pDMode^.dmPaperSize := DMPAPER_LEGAL;
end;
if Printer.Printing then
PrnHandle := Printer.Canvas.Handle
else
PrnHandle := Printer.Handle;
{$IFDEF WIN32}
if ResetDc(PrnHandle, pDMode^) <> 0 then
{$ELSE}
if ResetDc(PrnHandle, pDMode) <> 0 then
{$ENDIF}
CanReset := true else
CanReset := false;
Result := true;
GlobalUnlock(hDMode);
end;
end;
FreeMem(pDevice, cchDeviceName);
FreeMem(pDriver, MAX_PATH);
FreeMem(pPort, MAX_PATH);
end;
function TForm1.NewPage : bool;
begin
Result := true;
if CanReset then
EndPage(Printer.Canvas.Handle) else
Printer.EndDoc;
Inc(PageNumber);
if PageSetUp then begin
if CanReset then begin
StartPage(Printer.Canvas.Handle);
Printer.Canvas.Refresh;
end else
Printer.BeginDoc;
end else begin
if CanReset then begin
StartPage(Printer.Canvas.Handle);
Printer.Abort;
end;
Result := false;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
if PrintDialog1.Execute then begin
{Setup printing}
PageNumber := 1;
if not PageSetUp then begin
ShowMessage('Unable to customize printer settings');
exit;
end;
Printer.BeginDoc;
{Print page one}
Printer.Canvas.TextOut(100,100, 'Test Page 1');
if not NewPage then begin
ShowMessage('Unable to customize printer settings');
exit;
end;
{Print page two}
Printer.Canvas.TextOut(100,100, 'Test Page 2');
if not NewPage then begin
ShowMessage('Unable to customize printer settings');
exit;
end;
{Print page three}
Printer.Canvas.TextOut(100,100, 'Test Page 3');
Printer.EndDoc;
end;
end;
end.
Delphi - .....................................
WMI BASLANGIC (TYPE LIBRARY IMPORT)
WMI nın Delphide kullanılabilmesi için Import edilmesi gerekir.
Projects->Import Type Library->Microsoft WMI Scripting v1.x Library (Version 1.x)
Import edilen nesneler ActiveX sekmesine yerleşir.
WMI ile yapabilcekelerinizi görmek için Dos promptundan WMIC yazın ve konsoldan
/? ile yardım alın.
Not: 2000 ve XP de yüklü gelir.98 ve ME için Microsoft sitesinden indirilip yüklenmesi gerekir.
Delphi - .....................................
WMI ILE EXPLORERIN SAHIBINI BUL
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls,ActiveX, WbemScripting_TLB, Grids, Menus;
type
TForm1 = class(TForm)
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
Server: string;
implementation
{$R *.dfm}
function ADsEnumerateNext(pEnumVariant: IEnumVARIANT; cElements: ULONG;
var pvar: OleVARIANT; var pcElementsFetched: ULONG): HRESULT; safecall; external 'activeds.dll';
procedure TForm1.FormCreate(Sender: TObject);
var
Service: ISWbemServices;
Enum: IEnumVARIANT;
varArr: OleVariant;
lNumElements: ULong;
Method: ISWbemMethod;
OutParam: ISWbemObject;
SProp1: ISWbemProperty;
PropValue_1:OleVariant;
USER:STRING;
begin
try
SERVICE := CoSWbemLocator.Create.ConnectServer(Server, 'rootcimv2', '','', '', '', 0, nil);
ENUM:=SERVICE.ExecQuery('Select HANDLE from Win32_Process WHERE NAME="explorer.exe" ', 'WQL',wbemFlagBidirectional, nil)._NewEnum as IEnumVariant;
while (Succeeded(ADsEnumerateNext(Enum, 1, varArr, lNumElements))) and (lNumElements > 0) do
BEGIN
Method:= (IUnknown(varArr) as SWBemObject).Methods_.Item('GETOWNER', 0);
OutParam:= (IUnknown(varArr) as SWBemObject).ExecMethod_('GETOWNER', outParam, 0, nil);
SProp1:= outParam.Properties_.Item('USER', 0);
PropValue_1:=SProp1.Get_Value;
USER:=VarToStr(PropValue_1);
SHOWMESSAGE(USER);
END;
finally
end;
end;
end.
Delphi - .....................................
WMI ILE REMOTE BILGISAYARDAKI EXPLORER SAHIBINI BUL
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls,ActiveX, WbemScripting_TLB, Grids, Menus;
type
TForm1 = class(TForm)
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
Server: string;
implementation
{$R *.dfm}
function ADsEnumerateNext(pEnumVariant: IEnumVARIANT; cElements: ULONG;
var pvar: OleVARIANT; var pcElementsFetched: ULONG): HRESULT; safecall; external 'activeds.dll';
procedure TForm1.FormCreate(Sender: TObject);
var
Service: ISWbemServices;
Enum: IEnumVARIANT;
varArr: OleVariant;
lNumElements: ULong;
Method: ISWbemMethod;
OutParam: ISWbemObject;
SProp1: ISWbemProperty;
PropValue_1:OleVariant;
USER:STRING;
begin
try
// Memo1.Lines.BeginUpdate;
SERVICE := CoSWbemLocator.Create.ConnectServer(Server, 'rootcimv2', '','', '', '', 0, nil);
ENUM:=SERVICE.ExecQuery('Select HANDLE from Win32_Process WHERE NAME="explorer.exe" ', 'WQL',wbemFlagBidirectional, nil)._NewEnum as IEnumVariant;
while (Succeeded(ADsEnumerateNext(Enum, 1, varArr, lNumElements))) and (lNumElements > 0) do
BEGIN
Method:= (IUnknown(varArr) as SWBemObject).Methods_.Item('GETOWNER', 0);
//Method:= SOBject.Methods_.Item('GETOWNER', 0);
OutParam:= (IUnknown(varArr) as SWBemObject).ExecMethod_('GETOWNER', outParam, 0, nil);
SProp1:= outParam.Properties_.Item('USER', 0);
PropValue_1:=SProp1.Get_Value;
USER:=VarToStr(PropValue_1);
SHOWMESSAGE(USER);
END;
finally
end;
end;
end.
Delphi - .....................................
WMI ILE LOCAL YADA REMOTE BILGISAYARDAKI IP ADRESINI DEGISTIR
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls,ActiveX, WbemScripting_TLB, Grids, Menus,ComObj, UrlMon;
type
TForm1 = class(TForm)
Button1: TButton;
Edit1: TEdit;
Edit2: TEdit;
Label1: TLabel;
Label2: TLabel;
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
Server: string;
implementation
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
var Retvar : integer;
oBindObj : IDispatch;
oNetAdapters,oNetAdapter,
oIpAddress,oGateWay,
oWMIService,oSubnetMask : OleVariant;
i,iValue : longword;
oEnum : IEnumvariant;
oCtx : IBindCtx;
oMk : IMoniker;
sFileObj : widestring;
AIpAddress : string;
AGateWay : string ;
ASubnetMask : string ;
begin
AIpAddress:=EDIT1.TEXT;//'192.168.0.63';
ASubnetMask:=EDIT2.TEXT;
Retvar := 0;
sFileObj := 'winmgmts:'+SERVER+'rootcimv2';
// Create OLE [IN} Parameters
oIpAddress := VarArrayCreate([1,1],varOleStr);
oIpAddress[1] := AIpAddress;
oGateWay := VarArrayCreate([1,1],varOleStr);
oGateWay[1] := AGateWay;
oSubnetMask := VarArrayCreate([1,1],varOleStr);
if ASubnetMask = '' then
oSubnetMask[1] := '255.255.255.0'
else
oSubnetMask[1] := ASubnetMask;
OleCheck(CreateBindCtx(0,oCtx));
OleCheck(MkParseDisplayNameEx(oCtx,PWideChar(sFileObj),i,oMk));
OleCheck(oMk.BindToObject(oCtx,nil,IUnknown,oBindObj));
oWMIService := oBindObj;
oNetAdapters := oWMIService.ExecQuery('Select * from Win32_NetworkAdapterConfiguration where IPEnabled=TRUE');
oEnum := IUnknown(oNetAdapters._NewEnum) as IEnumVariant;
while oEnum.Next(1,oNetAdapter,iValue) = 0 do
begin
try
Retvar := oNetAdapter.EnableStatic(oIpAddress,oSubnetMask);
//IF Retvar=0 THEN ShowMessage('IP DEĞİŞŞTİRİLDİ');
except
Retvar := -1;
end;
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
IF ParamCount>0 THEN
SERVER:=ParamStr(1)
ELSE
SERVER:='.';
end;
end.
Delphi - .....................................
WMI ILE LOCAL YADA REMOTE BILGISAYARDAKI IP ADRESINI DEGISTIR
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls,ActiveX, WbemScripting_TLB, Grids, Menus,ComObj, UrlMon;
type
TForm1 = class(TForm)
Button1: TButton;
Edit1: TEdit;
Edit2: TEdit;
Label1: TLabel;
Label2: TLabel;
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
Server: string;
implementation
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
var Retvar : integer;
oBindObj : IDispatch;
oNetAdapters,oNetAdapter,
oIpAddress,oGateWay,
oWMIService,oSubnetMask : OleVariant;
i,iValue : longword;
oEnum : IEnumvariant;
oCtx : IBindCtx;
oMk : IMoniker;
sFileObj : widestring;
AIpAddress : string;
AGateWay : string ;
ASubnetMask : string ;
begin
AIpAddress:=EDIT1.TEXT;//'192.168.0.63';
ASubnetMask:=EDIT2.TEXT;
Retvar := 0;
sFileObj := 'winmgmts:'+SERVER+'rootcimv2';
// Create OLE [IN} Parameters
oIpAddress := VarArrayCreate([1,1],varOleStr);
oIpAddress[1] := AIpAddress;
oGateWay := VarArrayCreate([1,1],varOleStr);
oGateWay[1] := AGateWay;
oSubnetMask := VarArrayCreate([1,1],varOleStr);
if ASubnetMask = '' then
oSubnetMask[1] := '255.255.255.0'
else
oSubnetMask[1] := ASubnetMask;
OleCheck(CreateBindCtx(0,oCtx));
OleCheck(MkParseDisplayNameEx(oCtx,PWideChar(sFileObj),i,oMk));
OleCheck(oMk.BindToObject(oCtx,nil,IUnknown,oBindObj));
oWMIService := oBindObj;
oNetAdapters := oWMIService.ExecQuery('Select * from Win32_NetworkAdapterConfiguration where IPEnabled=TRUE');
oEnum := IUnknown(oNetAdapters._NewEnum) as IEnumVariant;
while oEnum.Next(1,oNetAdapter,iValue) = 0 do
begin
try
Retvar := oNetAdapter.EnableStatic(oIpAddress,oSubnetMask);
//IF Retvar=0 THEN ShowMessage('IP DEĞİŞŞTİRİLDİ');
except
Retvar := -1;
end;
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
IF ParamCount>0 THEN
SERVER:=ParamStr(1)
ELSE
SERVER:='.';
end;
end.
Delphi - .....................................
