Programlama yapalım ve Öğrenelim.

WMI ILE LOCAL YADA REMOTE BILGISAYARDAKI SERVIS LISTESINI ALMA / DURDURMA / BASLATMA

unit Unit1;

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, StdCtrls,ActiveX, WbemScripting_TLB, Grids, Menus;

type

TForm1 = class(TForm)

StringGrid1: TStringGrid;

MainMenu1: TMainMenu;

XTDOSYASINAAT1: TMenuItem;

SaveDialog1: TSaveDialog;

Memo1: TMemo;

PopupMenu1: TPopupMenu;

SERVIS1: TMenuItem;

YENILE1: TMenuItem;

procedure SERVICE_AL(IP_AL:STRING);

procedure FormCreate(Sender: TObject);

procedure XTDOSYASINAAT1Click(Sender: TObject);

procedure SERVIS1Click(Sender: TObject);

procedure StringGrid1SelectCell(Sender: TObject; ACol, ARow: Integer;

var CanSelect: Boolean);

procedure YENILE1Click(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form1: TForm1;

IP: string;

Service: ISWbemServices;

Enum: IEnumVARIANT;

SAYDIR:INTEGER;

implementation

{$R *.dfm}

function ADsEnumerateNext(pEnumVariant: IEnumVARIANT; cElements: ULONG;

var pvar: OleVARIANT; var pcElementsFetched: ULONG): HRESULT; safecall; external 'activeds.dll';

procedure DumpWMI_Process(Process: SWBemObject);

var

Enum: IEnumVARIANT;

varArr: OleVariant;

lNumElements: ULong;

SProp: ISWbemProperty;

Prop: OleVariant;

PropName: string;

PropType: string;

PropValue: string;

begin

//Form1.Memo1.Lines.Add('+ WMI Path: ' + Process.Path_.Path);

SAYDIR:=SAYDIR+1;

Form1.StringGrid1.RowCount:=Form1.StringGrid1.RowCount+1;

Enum := Process.Properties_._NewEnum as IEnumVariant;

while (Succeeded(ADsEnumerateNext(Enum, 1, VarArr, lNumElements))) and

(lNumElements > 0) do

begin

if Succeeded(IDispatch(varArr).QueryInterface(SWBemProperty, SProp)) and

Assigned(SProp) then

begin

try

PropName := SProp.Name;

Prop := SProp.Get_Value;

// PropType := VarTypeAsText(VarType(Prop));

PropType := VarAsType(VarType(Prop),varString);

PropValue := VarToStr(Prop);

IF PropName='Caption' THEN

Form1.StringGrid1.Cells[0,SAYDIR]:=PropValue;

IF PropName='Name' THEN

Form1.StringGrid1.Cells[1,SAYDIR]:=PropValue;

IF PropName='State' THEN

Form1.StringGrid1.Cells[2,SAYDIR]:=PropValue;

//Form1.Memo1.Lines[Form1.Memo1.Lines.Count-1]:=Form1.Memo1.Lines[Form1.Memo1.Lines.Count-1]+' - ' +PropValue;

except

on E: Exception do

begin

// WriteLn(ErrOutput, PropName, ': ', E.Message);

end;

procedure TForm1.SERVICE_AL(IP_AL:STRING);

var

varArr: OleVariant;

lNumElements: ULong;

begin

StringGrid1.Cells[0,0]:='SERVICE';

StringGrid1.Cells[1,0]:='NAME';

StringGrid1.Cells[2,0]:='STATUS';

SAYDIR:=0;

Try

SERVICE := CoSWbemLocator.Create.ConnectServer(IP_AL, 'rootcimv2', '','', '', '', 0, nil);

ENUM:=SERVICE.ExecQuery('Select * from Win32_Service', 'WQL',wbemFlagBidirectional, nil)._NewEnum as IEnumVariant;

while (Succeeded(ADsEnumerateNext(Enum, 1, varArr, lNumElements))) and

(lNumElements > 0) do

begin

DumpWMI_Process(IUnknown(varArr) as SWBemObject);

end;

finally

end;

procedure TForm1.FormCreate(Sender: TObject);

begin

StringGrid1.Cells[0,0]:='PROCESS';

StringGrid1.Cells[1,0]:='PID';

StringGrid1.Cells[2,0]:='DOSYA YOLU';

StringGrid1.Cells[3,0]:='KULLANICI';

IF ParamCount>0 THEN

IP:=ParamStr(1)

ELSE

IP:='.';

//StringGrid1.ColWidths[1]:=40;

SERVICE_AL(IP);

end;

procedure TForm1.XTDOSYASINAAT1Click(Sender: TObject);

var a:integer;

dosya:string;

begin

if SaveDialog1.Execute then

begin

memo1.lines.add(

StringGrid1.Cells[0,0]+CHR(09)+

StringGrid1.Cells[1,0]+CHR(09)+

StringGrid1.Cells[2,0]+CHR(09));

memo1.lines.add(stringofChar('-',200));

for a:=1 to StringGrid1.RowCount-1 do

begin

memo1.lines.add(

StringGrid1.Cells[0,a]+CHR(09)+

StringGrid1.Cells[1,a]+CHR(09)+

StringGrid1.Cells[2,a]+CHR(09));

end;

if copy(savedialog1.filename,length(savedialog1.filename)-3,4)<>'.txt' then

dosya:=savedialog1.filename+'.txt'

else dosya:=savedialog1.filename;

memo1.Lines.SaveToFile(dosya);

end;

procedure TForm1.SERVIS1Click(Sender: TObject);

VAR A:INTEGER;

PropValue: OleVariant;

Service: ISWbemServices;

Enum: IEnumVARIANT;

varArr: OleVariant;

lNumElements: ULong;

Method: ISWbemMethod;

OutParam: ISWbemObject;

begin

IF StringGrid1.Cells[0,StringGrid1.Row]='' THEN EXIT;

IF StringGrid1.Cells[1,StringGrid1.Row]='' THEN EXIT;

try

SERVICE := CoSWbemLocator.Create.ConnectServer(IP, 'rootcimv2', '','', '', '', 0, nil);

ENUM:=SERVICE.ExecQuery('Select NAME from Win32_SERVICE WHERE NAME="'+StringGrid1.Cells[1,StringGrid1.Row]+'" ', 'WQL',wbemFlagBidirectional, nil)._NewEnum as IEnumVariant;

while (Succeeded(ADsEnumerateNext(Enum, 1, varArr, lNumElements))) and (lNumElements > 0) do

BEGIN

PropValue:= 0;

IF StringGrid1.Cells[2,StringGrid1.Row]='Running' THEN

BEGIN

Method:= (IUnknown(varArr) as SWBemObject).Methods_.Item('StopService', 0);

OutParam:= (IUnknown(varArr) as SWBemObject).ExecMethod_('StopService', nil, 0, nil);

END;

IF StringGrid1.Cells[2,StringGrid1.Row]='Stopped' THEN

BEGIN

Method:= (IUnknown(varArr) as SWBemObject).Methods_.Item('StartService', 0);

OutParam:= (IUnknown(varArr) as SWBemObject).ExecMethod_('StartService', nil, 0, nil);

END;

finally

end;

FOR A:=1 TO StringGrid1.RowCount-1 DO

BEGIN

StringGrid1.Cells[0,A]:='';

StringGrid1.Cells[1,A]:='';

StringGrid1.Cells[2,A]:='';

StringGrid1.Cells[3,A]:='';

END;

Form1.StringGrid1.RowCount:=2;

SERVICE_AL(IP);

end;

procedure TForm1.StringGrid1SelectCell(Sender: TObject; ACol,

ARow: Integer; var CanSelect: Boolean);

begin

SERVIS1.Enabled:=TRUE;

IF StringGrid1.Cells[2,ARow]='Running' THEN SERVIS1.Caption:='DURDUR'

ELSE IF StringGrid1.Cells[2,ARow]='Stopped' THEN SERVIS1.Caption:='BAŞLAT'

ELSE SERVIS1.Enabled:=FALSE;

end;

procedure TForm1.YENILE1Click(Sender: TObject);

VAR A:INTEGER;

begin

FOR A:=1 TO StringGrid1.RowCount-1 DO

BEGIN

StringGrid1.Cells[0,A]:='';

StringGrid1.Cells[1,A]:='';

StringGrid1.Cells[2,A]:='';

StringGrid1.Cells[3,A]:='';

END;

StringGrid1.RowCount:=2;

SERVICE_AL(IP);

end;

end.

Delphi - .....................................

WMI ILE LOCAL YADA REMOTE BILGISAYARDAKI SERVIS LISTESINI ALMA / DURDURMA / BASLATMA

unit Unit1;

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, StdCtrls,ActiveX, WbemScripting_TLB, Grids, Menus;

type

TForm1 = class(TForm)

StringGrid1: TStringGrid;

MainMenu1: TMainMenu;

XTDOSYASINAAT1: TMenuItem;

SaveDialog1: TSaveDialog;

Memo1: TMemo;

PopupMenu1: TPopupMenu;

SERVIS1: TMenuItem;

YENILE1: TMenuItem;

procedure SERVICE_AL(IP_AL:STRING);

procedure FormCreate(Sender: TObject);

procedure XTDOSYASINAAT1Click(Sender: TObject);

procedure SERVIS1Click(Sender: TObject);

procedure StringGrid1SelectCell(Sender: TObject; ACol, ARow: Integer;

var CanSelect: Boolean);

procedure YENILE1Click(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form1: TForm1;

IP: string;

Service: ISWbemServices;

Enum: IEnumVARIANT;

SAYDIR:INTEGER;

implementation

{$R *.dfm}

function ADsEnumerateNext(pEnumVariant: IEnumVARIANT; cElements: ULONG;

var pvar: OleVARIANT; var pcElementsFetched: ULONG): HRESULT; safecall; external 'activeds.dll';

procedure DumpWMI_Process(Process: SWBemObject);

var

Enum: IEnumVARIANT;

varArr: OleVariant;

lNumElements: ULong;

SProp: ISWbemProperty;

Prop: OleVariant;

PropName: string;

PropType: string;

PropValue: string;

begin

//Form1.Memo1.Lines.Add('+ WMI Path: ' + Process.Path_.Path);

SAYDIR:=SAYDIR+1;

Form1.StringGrid1.RowCount:=Form1.StringGrid1.RowCount+1;

Enum := Process.Properties_._NewEnum as IEnumVariant;

while (Succeeded(ADsEnumerateNext(Enum, 1, VarArr, lNumElements))) and

(lNumElements > 0) do

begin

if Succeeded(IDispatch(varArr).QueryInterface(SWBemProperty, SProp)) and

Assigned(SProp) then

begin

try

PropName := SProp.Name;

Prop := SProp.Get_Value;

// PropType := VarTypeAsText(VarType(Prop));

PropType := VarAsType(VarType(Prop),varString);

PropValue := VarToStr(Prop);

IF PropName='Caption' THEN

Form1.StringGrid1.Cells[0,SAYDIR]:=PropValue;

IF PropName='Name' THEN

Form1.StringGrid1.Cells[1,SAYDIR]:=PropValue;

IF PropName='State' THEN

Form1.StringGrid1.Cells[2,SAYDIR]:=PropValue;

//Form1.Memo1.Lines[Form1.Memo1.Lines.Count-1]:=Form1.Memo1.Lines[Form1.Memo1.Lines.Count-1]+' - ' +PropValue;

except

on E: Exception do

begin

// WriteLn(ErrOutput, PropName, ': ', E.Message);

end;

procedure TForm1.SERVICE_AL(IP_AL:STRING);

var

varArr: OleVariant;

lNumElements: ULong;

begin

StringGrid1.Cells[0,0]:='SERVICE';

StringGrid1.Cells[1,0]:='NAME';

StringGrid1.Cells[2,0]:='STATUS';

SAYDIR:=0;

Try

SERVICE := CoSWbemLocator.Create.ConnectServer(IP_AL, 'rootcimv2', '','', '', '', 0, nil);

ENUM:=SERVICE.ExecQuery('Select * from Win32_Service', 'WQL',wbemFlagBidirectional, nil)._NewEnum as IEnumVariant;

while (Succeeded(ADsEnumerateNext(Enum, 1, varArr, lNumElements))) and

(lNumElements > 0) do

begin

DumpWMI_Process(IUnknown(varArr) as SWBemObject);

end;

finally

end;

procedure TForm1.FormCreate(Sender: TObject);

begin

StringGrid1.Cells[0,0]:='PROCESS';

StringGrid1.Cells[1,0]:='PID';

StringGrid1.Cells[2,0]:='DOSYA YOLU';

StringGrid1.Cells[3,0]:='KULLANICI';

IF ParamCount>0 THEN

IP:=ParamStr(1)

ELSE

IP:='.';

//StringGrid1.ColWidths[1]:=40;

SERVICE_AL(IP);

end;

procedure TForm1.XTDOSYASINAAT1Click(Sender: TObject);

var a:integer;

dosya:string;

begin

if SaveDialog1.Execute then

begin

memo1.lines.add(

StringGrid1.Cells[0,0]+CHR(09)+

StringGrid1.Cells[1,0]+CHR(09)+

StringGrid1.Cells[2,0]+CHR(09));

memo1.lines.add(stringofChar('-',200));

for a:=1 to StringGrid1.RowCount-1 do

begin

memo1.lines.add(

StringGrid1.Cells[0,a]+CHR(09)+

StringGrid1.Cells[1,a]+CHR(09)+

StringGrid1.Cells[2,a]+CHR(09));

end;

if copy(savedialog1.filename,length(savedialog1.filename)-3,4)<>'.txt' then

dosya:=savedialog1.filename+'.txt'

else dosya:=savedialog1.filename;

memo1.Lines.SaveToFile(dosya);

end;

procedure TForm1.SERVIS1Click(Sender: TObject);

VAR A:INTEGER;

PropValue: OleVariant;

Service: ISWbemServices;

Enum: IEnumVARIANT;

varArr: OleVariant;

lNumElements: ULong;

Method: ISWbemMethod;

OutParam: ISWbemObject;

begin

IF StringGrid1.Cells[0,StringGrid1.Row]='' THEN EXIT;

IF StringGrid1.Cells[1,StringGrid1.Row]='' THEN EXIT;

try

SERVICE := CoSWbemLocator.Create.ConnectServer(IP, 'rootcimv2', '','', '', '', 0, nil);

ENUM:=SERVICE.ExecQuery('Select NAME from Win32_SERVICE WHERE NAME="'+StringGrid1.Cells[1,StringGrid1.Row]+'" ', 'WQL',wbemFlagBidirectional, nil)._NewEnum as IEnumVariant;

while (Succeeded(ADsEnumerateNext(Enum, 1, varArr, lNumElements))) and (lNumElements > 0) do

BEGIN

PropValue:= 0;

IF StringGrid1.Cells[2,StringGrid1.Row]='Running' THEN

BEGIN

Method:= (IUnknown(varArr) as SWBemObject).Methods_.Item('StopService', 0);

OutParam:= (IUnknown(varArr) as SWBemObject).ExecMethod_('StopService', nil, 0, nil);

END;

IF StringGrid1.Cells[2,StringGrid1.Row]='Stopped' THEN

BEGIN

Method:= (IUnknown(varArr) as SWBemObject).Methods_.Item('StartService', 0);

OutParam:= (IUnknown(varArr) as SWBemObject).ExecMethod_('StartService', nil, 0, nil);

END;

finally

end;

FOR A:=1 TO StringGrid1.RowCount-1 DO

BEGIN

StringGrid1.Cells[0,A]:='';

StringGrid1.Cells[1,A]:='';

StringGrid1.Cells[2,A]:='';

StringGrid1.Cells[3,A]:='';

END;

Form1.StringGrid1.RowCount:=2;

SERVICE_AL(IP);

end;

procedure TForm1.StringGrid1SelectCell(Sender: TObject; ACol,

ARow: Integer; var CanSelect: Boolean);

begin

SERVIS1.Enabled:=TRUE;

IF StringGrid1.Cells[2,ARow]='Running' THEN SERVIS1.Caption:='DURDUR'

ELSE IF StringGrid1.Cells[2,ARow]='Stopped' THEN SERVIS1.Caption:='BAŞLAT'

ELSE SERVIS1.Enabled:=FALSE;

end;

procedure TForm1.YENILE1Click(Sender: TObject);

VAR A:INTEGER;

begin

FOR A:=1 TO StringGrid1.RowCount-1 DO

BEGIN

StringGrid1.Cells[0,A]:='';

StringGrid1.Cells[1,A]:='';

StringGrid1.Cells[2,A]:='';

StringGrid1.Cells[3,A]:='';

END;

StringGrid1.RowCount:=2;

SERVICE_AL(IP);

end;

end.

Delphi - .....................................

WINDOWS EVENTLOGUNDAKI MESAJLARI OKUMA

unit Unit1;

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, StdCtrls,registry;

type

TForm1 = class(TForm)

Button1: TButton;

Memo1: TMemo;

procedure Button1Click(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

const

// Flags of events that can be logged.

EVENTLOG_SEQUENTIAL_READ = $0001;

EVENTLOG_SEEK_READ = $0002;

EVENTLOG_FORWARDS_READ = $0004;

EVENTLOG_BACKWARDS_READ = $0008;

// The types of events that can be logged.

EVENTLOG_SUCCESS = $0000;

EVENTLOG_ERROR_TYPE = $0001;

EVENTLOG_WARNING_TYPE = $0002;

EVENTLOG_INFORMATION_TYPE = $0004;

EVENTLOG_AUDIT_SUCCESS = $0008;

EVENTLOG_AUDIT_FAILURE = $0016;

type

PEventLogRecord = ^TEventLogRecord;

TEventLogRecord = class

ComputerName: string;

Description: PChar;

EventCategory: word;

EventID: DWORD;

EventType: word;

RecordNumber: DWORD;

SourceName: string;

TimeGenerated: TDateTime;

UserName: String;

end;

PEventLog = ^TEventLog;

TEventLog = record

Length : DWord;

Reserved : DWord;

RecordNumber : DWord;

TimeGenerated : DWord;

TimeWritten : DWord;

EventID : DWord;

EventType : Word;

NumStrings : Word;

EventCategory : Word;

ReservedFlags : Word;

ClosingRecordNumber: DWord;

StringOffset : DWord;

UserSIDLength : DWord;

UserSIDOffset : DWord;

DataLength : DWord;

DataOffset : DWord;

end;

var

Form1: TForm1;

implementation

{$R *.dfm}

function GetRegValue(aRootKey: HKEY; aKey, aValue: string): string;

var

lReg: TRegistry;

begin

Result := '';

lReg := TRegistry.Create;

try

with lReg do

begin

RootKey := aRootKey;

if OpenKeyReadOnly(aKey) then

Result := ReadString(aValue);

end;

finally

lReg.Free;

end;

function GetAccountName(const aSID: PSID): string;

var

lpDomainName,

lpUserName: string;

szDomainName,

szUserName: DWord;

peUse: DWord;

begin

Result := EmptyStr;

szDomainName := 0;

szUserName := 0;

LookupAccountSid(nil, aSID, nil, szUserName, nil, szDomainName, peUse);

SetLength(lpUserName, szUserName);

SetLength(lpDomainName, szDomainName);

if LookupAccountSid(nil, aSID, PChar(lpUserName), szUserName, PChar(lpDomainName), szDomainName, peUse) then

begin

SetLength(lpUserName,szUserName);

SetLength(lpDomainName,szDomainName);

Result:=Format('%s%s',[lpDomainName,lpUserName]);;

end;

function EventTypeToStr(aEventType: Word): String;

begin

case aEventType of

EVENTLOG_SUCCESS: Result:= 'Success';

EVENTLOG_ERROR_TYPE: Result:= 'Error';

EVENTLOG_WARNING_TYPE: Result:= 'Warning';

EVENTLOG_INFORMATION_TYPE: Result:= 'Information';

EVENTLOG_AUDIT_SUCCESS: Result:= 'Success audit';

EVENTLOG_AUDIT_FAILURE: Result:= 'Failure audit';

else

Result:= 'Unknown';

end;

function HoursTimeZone: TDateTime;

var

lpTimeZoneInformation: TTimeZoneInformation;

Bias: Longint;

begin

GetTimeZoneInformation(lpTimeZoneInformation);

Bias := lpTimeZoneInformation.Bias;

Result := EncodeTime(Abs(Bias div 60), 0, 0, 0);

if Bias > 0 then Result := -Result;

end;

function UnixDateTimeToDelphiDateTime(UnixDateTime: LongInt):TDateTime;

begin

Result := EncodeDate(1970, 1, 1) + (UnixDateTime / 86400) + HoursTimeZone; {86400=No. of secs. per day}

end;

procedure TForm1.Button1Click(Sender: TObject);

var

hModule : THandle;

hEventLog : THandle;

EventLogPtr : pointer;

lpBuffer : PEventLog;

dwEventLogRecords : DWORD;

dwBytesRead : DWORD;

dwBytesNeed : DWORD;

dwBufSize : DWORD;

OutputStr : array[0..255] of char;

EventMessageFile : PChar;

FirstArgument : PChar;

NextArgument : PChar;

EventLogRecord : TEventLogRecord;

i, iNumStrings : integer;

ArgsBuffer : array of string;

lpMsgBuf : PChar;

dwArgumentOffset : DWORD;

begin

dwBytesRead := 0;

dwBytesNeed := 0;

//hEventLog := OpenEventLog(nil, PChar('Application'));

hEventLog := OpenEventLog(nil, PChar('System'));

if hEventLog = 0 then

raise Exception.Create(SysErrorMessage(GetLastError));

if not GetNumberOfEventLogRecords(hEventLog, dwEventLogRecords) then

dwEventLogRecords := 512;

dwBufSize := 64*1024;

GetMem(EventLogPtr, dwBufSize);

lpBuffer := EventLogPtr;

try

while ReadEventLog(hEventLog, EVENTLOG_FORWARDS_READ or EVENTLOG_SEQUENTIAL_READ, 0, EventLogPtr, dwBufSize, dwBytesRead, dwBytesNeed) do

begin

while dwBytesRead > 0 do

begin

with TEventLog(lpBuffer^) do

begin

EventLogRecord := TEventLogRecord.Create;

EventLogRecord.EventType := EventType;

EventLogRecord.TimeGenerated := UnixDateTimeToDelphiDateTime(TimeGenerated);

EventLogRecord.SourceName := PChar(DWORD(lpBuffer)+DWORD(SizeOf(TEventLog)));

EventLogRecord.EventCategory := EventCategory;

EventLogRecord.EventID := EventID;

if TEventLog(lpBuffer^).UserSIDLength > 0 then

EventLogRecord.UserName := GetAccountName(PSID(DWORD(lpBuffer) + DWORD(TEventLog(lpBuffer^).UserSIDOffset)))

else

EventLogRecord.UserName := '(blank)';

EventLogRecord.ComputerName := PChar(DWORD(lpBuffer)+DWORD(SizeOf(TEventLog)+System.Length(EventLogRecord.SourceName)+1));

FirstArgument := PChar(DWORD(lpBuffer)+DWORD(StringOffset));

iNumStrings := TEventLog(lpBuffer^).NumStrings;

// Fix for latest changes in Windows 2000/XP which could return iNumStrings = 0

if iNumStrings > 0 then

begin

SetLength(ArgsBuffer, iNumStrings);

try

dwArgumentOffset := DWORD(StrLen(FirstArgument)+1);

ArgsBuffer[0] := FirstArgument;

for i := 1 to iNumStrings-1 do

begin

NextArgument := PChar(DWORD(lpBuffer)+DWORD(StringOffset)+dwArgumentOffset);

ArgsBuffer[i] := NextArgument;

dwArgumentOffset := dwArgumentOffset + StrLen(NextArgument) + 1;

end;

except

SetLength(ArgsBuffer, 1);

ArgsBuffer[0] := '';

end;

EventMessageFile := PChar(GetRegValue(HKEY_LOCAL_MACHINE,

'SYSTEMCurrentControlSetServicesEventLogApplication'+EventLogRecord.SourceName, 'EventMessageFile'));

FillChar(OutputStr, SizeOf(OutputStr), 0);

ExpandEnvironmentStrings(EventMessageFile, OutputStr, SizeOf(OutputStr));

if OutputStr <> EventMessageFile then

EventMessageFile := OutputStr;

hModule := LoadLibraryEx(PChar(EventMessageFile), 0, DONT_RESOLVE_DLL_REFERENCES);

FillChar(lpMsgBuf, SizeOf(lpMsgBuf), 0);

if hModule <> 0 then

try

FormatMessage( FORMAT_MESSAGE_ALLOCATE_BUFFER or

FORMAT_MESSAGE_FROM_HMODULE or

FORMAT_MESSAGE_FROM_SYSTEM or

FORMAT_MESSAGE_ARGUMENT_ARRAY,

Pointer(hModule),

EventLogRecord.EventID,

PChar(@lpMsgBuf), SizeOf(lpMsgBuf), ArgsBuffer);

finally

FreeLibrary(hModule);

ArgsBuffer := nil;

end;

EventLogRecord.Description := lpMsgBuf;

lpMsgBuf := nil;

EventLogRecord.RecordNumber := RecordNumber;

//ShowMessage(EventTypeToStr(EventType));

memo1.Lines.add('ComputerName:'+EventLogRecord.ComputerName);

memo1.Lines.add('Description:'+EventLogRecord.Description);

memo1.Lines.add('EventCategory'+INTTOSTR(EventLogRecord.EventCategory));

memo1.Lines.add('EventType'+EventTypeToStr(EventType));

memo1.Lines.add('EventID'+INTTOSTR(EventLogRecord.EventID));

memo1.Lines.add('RecordNumber'+INTTOSTR(EventLogRecord.RecordNumber));

memo1.Lines.add('SourceName'+EventLogRecord.SourceName);

memo1.Lines.add('TimeGenerated'+DateTimeToStr(EventLogRecord.TimeGenerated));

memo1.Lines.add('UserName'+EventLogRecord.UserName);

memo1.Lines.add('-------------------');

Application.ProcessMessages;

end;

dwBytesRead := dwBytesRead - TEventLog(lpBuffer^).Length;

lpBuffer := PEventLog(DWORD(lpBuffer) + TEventLog(lpBuffer^).Length);

end;

lpBuffer := EventLogPtr;

end;

finally

FreeMem(EventLogPtr, dwBufSize);

CloseEventLog(hEventLog);

end;

end.

Delphi - .....................................

WINDOWS EVENTLOGUNDAKI MESAJLARI OKUMA

unit Unit1;

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, StdCtrls,registry;

type

TForm1 = class(TForm)

Button1: TButton;

Memo1: TMemo;

procedure Button1Click(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

const

// Flags of events that can be logged.

EVENTLOG_SEQUENTIAL_READ = $0001;

EVENTLOG_SEEK_READ = $0002;

EVENTLOG_FORWARDS_READ = $0004;

EVENTLOG_BACKWARDS_READ = $0008;

// The types of events that can be logged.

EVENTLOG_SUCCESS = $0000;

EVENTLOG_ERROR_TYPE = $0001;

EVENTLOG_WARNING_TYPE = $0002;

EVENTLOG_INFORMATION_TYPE = $0004;

EVENTLOG_AUDIT_SUCCESS = $0008;

EVENTLOG_AUDIT_FAILURE = $0016;

type

PEventLogRecord = ^TEventLogRecord;

TEventLogRecord = class

ComputerName: string;

Description: PChar;

EventCategory: word;

EventID: DWORD;

EventType: word;

RecordNumber: DWORD;

SourceName: string;

TimeGenerated: TDateTime;

UserName: String;

end;

PEventLog = ^TEventLog;

TEventLog = record

Length : DWord;

Reserved : DWord;

RecordNumber : DWord;

TimeGenerated : DWord;

TimeWritten : DWord;

EventID : DWord;

EventType : Word;

NumStrings : Word;

EventCategory : Word;

ReservedFlags : Word;

ClosingRecordNumber: DWord;

StringOffset : DWord;

UserSIDLength : DWord;

UserSIDOffset : DWord;

DataLength : DWord;

DataOffset : DWord;

end;

var

Form1: TForm1;

implementation

{$R *.dfm}

function GetRegValue(aRootKey: HKEY; aKey, aValue: string): string;

var

lReg: TRegistry;

begin

Result := '';

lReg := TRegistry.Create;

try

with lReg do

begin

RootKey := aRootKey;

if OpenKeyReadOnly(aKey) then

Result := ReadString(aValue);

end;

finally

lReg.Free;

end;

function GetAccountName(const aSID: PSID): string;

var

lpDomainName,

lpUserName: string;

szDomainName,

szUserName: DWord;

peUse: DWord;

begin

Result := EmptyStr;

szDomainName := 0;

szUserName := 0;

LookupAccountSid(nil, aSID, nil, szUserName, nil, szDomainName, peUse);

SetLength(lpUserName, szUserName);

SetLength(lpDomainName, szDomainName);

if LookupAccountSid(nil, aSID, PChar(lpUserName), szUserName, PChar(lpDomainName), szDomainName, peUse) then

begin

SetLength(lpUserName,szUserName);

SetLength(lpDomainName,szDomainName);

Result:=Format('%s%s',[lpDomainName,lpUserName]);;

end;

function EventTypeToStr(aEventType: Word): String;

begin

case aEventType of

EVENTLOG_SUCCESS: Result:= 'Success';

EVENTLOG_ERROR_TYPE: Result:= 'Error';

EVENTLOG_WARNING_TYPE: Result:= 'Warning';

EVENTLOG_INFORMATION_TYPE: Result:= 'Information';

EVENTLOG_AUDIT_SUCCESS: Result:= 'Success audit';

EVENTLOG_AUDIT_FAILURE: Result:= 'Failure audit';

else

Result:= 'Unknown';

end;

function HoursTimeZone: TDateTime;

var

lpTimeZoneInformation: TTimeZoneInformation;

Bias: Longint;

begin

GetTimeZoneInformation(lpTimeZoneInformation);

Bias := lpTimeZoneInformation.Bias;

Result := EncodeTime(Abs(Bias div 60), 0, 0, 0);

if Bias > 0 then Result := -Result;

end;

function UnixDateTimeToDelphiDateTime(UnixDateTime: LongInt):TDateTime;

begin

Result := EncodeDate(1970, 1, 1) + (UnixDateTime / 86400) + HoursTimeZone; {86400=No. of secs. per day}

end;

procedure TForm1.Button1Click(Sender: TObject);

var

hModule : THandle;

hEventLog : THandle;

EventLogPtr : pointer;

lpBuffer : PEventLog;

dwEventLogRecords : DWORD;

dwBytesRead : DWORD;

dwBytesNeed : DWORD;

dwBufSize : DWORD;

OutputStr : array[0..255] of char;

EventMessageFile : PChar;

FirstArgument : PChar;

NextArgument : PChar;

EventLogRecord : TEventLogRecord;

i, iNumStrings : integer;

ArgsBuffer : array of string;

lpMsgBuf : PChar;

dwArgumentOffset : DWORD;

begin

dwBytesRead := 0;

dwBytesNeed := 0;

//hEventLog := OpenEventLog(nil, PChar('Application'));

hEventLog := OpenEventLog(nil, PChar('System'));

if hEventLog = 0 then

raise Exception.Create(SysErrorMessage(GetLastError));

if not GetNumberOfEventLogRecords(hEventLog, dwEventLogRecords) then

dwEventLogRecords := 512;

dwBufSize := 64*1024;

GetMem(EventLogPtr, dwBufSize);

lpBuffer := EventLogPtr;

try

while ReadEventLog(hEventLog, EVENTLOG_FORWARDS_READ or EVENTLOG_SEQUENTIAL_READ, 0, EventLogPtr, dwBufSize, dwBytesRead, dwBytesNeed) do

begin

while dwBytesRead > 0 do

begin

with TEventLog(lpBuffer^) do

begin

EventLogRecord := TEventLogRecord.Create;

EventLogRecord.EventType := EventType;

EventLogRecord.TimeGenerated := UnixDateTimeToDelphiDateTime(TimeGenerated);

EventLogRecord.SourceName := PChar(DWORD(lpBuffer)+DWORD(SizeOf(TEventLog)));

EventLogRecord.EventCategory := EventCategory;

EventLogRecord.EventID := EventID;

if TEventLog(lpBuffer^).UserSIDLength > 0 then

EventLogRecord.UserName := GetAccountName(PSID(DWORD(lpBuffer) + DWORD(TEventLog(lpBuffer^).UserSIDOffset)))

else

EventLogRecord.UserName := '(blank)';

EventLogRecord.ComputerName := PChar(DWORD(lpBuffer)+DWORD(SizeOf(TEventLog)+System.Length(EventLogRecord.SourceName)+1));

FirstArgument := PChar(DWORD(lpBuffer)+DWORD(StringOffset));

iNumStrings := TEventLog(lpBuffer^).NumStrings;

// Fix for latest changes in Windows 2000/XP which could return iNumStrings = 0

if iNumStrings > 0 then

begin

SetLength(ArgsBuffer, iNumStrings);

try

dwArgumentOffset := DWORD(StrLen(FirstArgument)+1);

ArgsBuffer[0] := FirstArgument;

for i := 1 to iNumStrings-1 do

begin

NextArgument := PChar(DWORD(lpBuffer)+DWORD(StringOffset)+dwArgumentOffset);

ArgsBuffer[i] := NextArgument;

dwArgumentOffset := dwArgumentOffset + StrLen(NextArgument) + 1;

end;

except

SetLength(ArgsBuffer, 1);

ArgsBuffer[0] := '';

end;

EventMessageFile := PChar(GetRegValue(HKEY_LOCAL_MACHINE,

'SYSTEMCurrentControlSetServicesEventLogApplication'+EventLogRecord.SourceName, 'EventMessageFile'));

FillChar(OutputStr, SizeOf(OutputStr), 0);

ExpandEnvironmentStrings(EventMessageFile, OutputStr, SizeOf(OutputStr));

if OutputStr <> EventMessageFile then

EventMessageFile := OutputStr;

hModule := LoadLibraryEx(PChar(EventMessageFile), 0, DONT_RESOLVE_DLL_REFERENCES);

FillChar(lpMsgBuf, SizeOf(lpMsgBuf), 0);

if hModule <> 0 then

try

FormatMessage( FORMAT_MESSAGE_ALLOCATE_BUFFER or

FORMAT_MESSAGE_FROM_HMODULE or

FORMAT_MESSAGE_FROM_SYSTEM or

FORMAT_MESSAGE_ARGUMENT_ARRAY,

Pointer(hModule),

EventLogRecord.EventID,

PChar(@lpMsgBuf), SizeOf(lpMsgBuf), ArgsBuffer);

finally

FreeLibrary(hModule);

ArgsBuffer := nil;

end;

EventLogRecord.Description := lpMsgBuf;

lpMsgBuf := nil;

EventLogRecord.RecordNumber := RecordNumber;

//ShowMessage(EventTypeToStr(EventType));

memo1.Lines.add('ComputerName:'+EventLogRecord.ComputerName);

memo1.Lines.add('Description:'+EventLogRecord.Description);

memo1.Lines.add('EventCategory'+INTTOSTR(EventLogRecord.EventCategory));

memo1.Lines.add('EventType'+EventTypeToStr(EventType));

memo1.Lines.add('EventID'+INTTOSTR(EventLogRecord.EventID));

memo1.Lines.add('RecordNumber'+INTTOSTR(EventLogRecord.RecordNumber));

memo1.Lines.add('SourceName'+EventLogRecord.SourceName);

memo1.Lines.add('TimeGenerated'+DateTimeToStr(EventLogRecord.TimeGenerated));

memo1.Lines.add('UserName'+EventLogRecord.UserName);

memo1.Lines.add('-------------------');

Application.ProcessMessages;

end;

dwBytesRead := dwBytesRead - TEventLog(lpBuffer^).Length;

lpBuffer := PEventLog(DWORD(lpBuffer) + TEventLog(lpBuffer^).Length);

end;

lpBuffer := EventLogPtr;

end;

finally

FreeMem(EventLogPtr, dwBufSize);

CloseEventLog(hEventLog);

end;

end.

Delphi - .....................................

WINDOWS EVENTLOGA MESAJ EKLEME

procedure TForm1.Button1Click(Sender: TObject);

var

lEventLog : THandle;

lValue : PChar;

lLength : integer;

lSomeString : string;

begin

// when application is started

lEventLog := RegisterEventSource(nil, PChar('MyApplication'));

// this is just temp varuable

lSomeString := 'A test event message';

lLength := Length(lSomeString) + 2;

// Allocate memory and copy string

lValue := AllocMem(lLength);

StrPCopy(lValue, lSomeString);

// Information type record is created

ReportEvent(lEventLog, EVENTLOG_INFORMATION_TYPE, 0, 0, nil, 1, 0, @lValue, nil);

// when application is about to be closed

// if (lEvent <> 0) then

if (lEventLog <> 0) THEN

DeregisterEventSource(lEventLog);

end;

Delphi - .....................................

WINDOWS EVENTLOGA MESAJ EKLEME

procedure TForm1.Button1Click(Sender: TObject);

var

lEventLog : THandle;

lValue : PChar;

lLength : integer;

lSomeString : string;

begin

// when application is started

lEventLog := RegisterEventSource(nil, PChar('MyApplication'));

// this is just temp varuable

lSomeString := 'A test event message';

lLength := Length(lSomeString) + 2;

// Allocate memory and copy string

lValue := AllocMem(lLength);

StrPCopy(lValue, lSomeString);

// Information type record is created

ReportEvent(lEventLog, EVENTLOG_INFORMATION_TYPE, 0, 0, nil, 1, 0, @lValue, nil);

// when application is about to be closed

// if (lEvent <> 0) then

if (lEventLog <> 0) THEN

DeregisterEventSource(lEventLog);

end;

Delphi - .....................................

LOCAL YADA REMOTE ZAMANLANMIS GOREV EKLEME DUZENLEME (TASKSCHED)

Açık bütün pencereleri listeleme

function EnumWindowsProc(Wnd : HWnd;Form : TForm1) : Boolean; Export; {$ifdef Win32} StdCall; {$endif}

var

Buffer : Array[0..99] of char;

begin

GetWindowText(Wnd,Buffer,100);

if StrLen(Buffer) <> 0 then

Form.ListBox1.Items.Add(StrPas(Buffer));

Result := True;

end;

procedure TForm1.Button1Click(Sender: TObject);

begin

EnumWindows(@EnumWindowsProc,LongInt(Self));

end;

Delphi - .....................................

LOCAL YADA REMOTE ZAMANLANMIS GOREV EKLEME DUZENLEME (TASKSCHED)

Açık bütün pencereleri listeleme

function EnumWindowsProc(Wnd : HWnd;Form : TForm1) : Boolean; Export; {$ifdef Win32} StdCall; {$endif}

var

Buffer : Array[0..99] of char;

begin

GetWindowText(Wnd,Buffer,100);

if StrLen(Buffer) <> 0 then

Form.ListBox1.Items.Add(StrPas(Buffer));

Result := True;

end;

procedure TForm1.Button1Click(Sender: TObject);

begin

EnumWindows(@EnumWindowsProc,LongInt(Self));

end;

Delphi - .....................................

ZAMANLANMIS GOREV EKLEME 1(NETSCHEDULEJOBADD)

//1.YOL

unit insjob;

interface

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,

StdCtrls;

type

TAT_INFO = record

JobTime: DWord;

DaysOfMonth: DWord;

DaysOfWeek: UCHAR;

Flags: UCHAR;

Command: PWideChar;

end;

PAT_INFO = ^TAT_INFO;

NET_API_STATUS = LongInt;

TForm1 = class(TForm)

Button1: TButton;

procedure Button1Click(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

function NetScheduleJobAdd(ServerName: PWideChar; Buffer: PAT_INFO; var JobID: PDWord): NET_API_STATUS;stdcall;

var

Form1: TForm1;

implementation

{$R *.DFM}

function NetScheduleJobAdd; external 'netapi32.dll' name 'NetScheduleJobAdd';

procedure TForm1.Button1Click(Sender: TObject);

var

ATInfo:PAT_Info;

jobid:PDword;

begin

getmem(atinfo,sizeof(TAt_info));

getmem(jobid,sizeof(dword));

atinfo^.jobtime:=3*60*60*1000+15*60*1000;//miliseconds from midnight to 3:15

atinfo^.DaysOfMonth:=4294967295;

atinfo^.DaysOfWeek:=255;

atinfo^.command:='c:showok.exe';

atinfo^.flags:=1;//job_run_periodic

if NetScheduleJobAdd(nil,atinfo,jobid)<>2 then//job_exec_error=2

showmessage('ok');

freemem(jobid);

freemem(atinfo);

end;

end.

//2.YOL

unit Unit1;

interface

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,

StdCtrls;

type

Pat_info= ^at_info;

at_info = record

JobTime:DWORD;

DaysOfMonth:DWORD;

DaysOfWeek:UCHAR;

Flags:UCHAR;

Command:LPWSTR;

end;

type

TForm1 = class(TForm)

Button1: TButton;

Button2: TButton;

procedure Button1Click(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

const

JOB_RUN_PERIODICALLY = $01; { in-/output flag }

JOB_EXEC_ERROR = $02; { output flag }

JOB_RUNS_TODAY = $04; { output flag }

JOB_ADD_CURRENT_DATE = $08; { input flag }

JOB_NONINTERACTIVE = $10; { in-/output flag }

var

Form1: TForm1;

implementation

{$R *.DFM}

function NetScheduleJobAdd(

aMachine:string; // empty string for local machine

aTime: DWORD; // millisec. from midnight

DaysOfMonth: DWORD; //bit 0: 1. day bit1: 2. day value=0: not assigned

DaysOfWeek: byte; //bit 0: Monday .... value=0: not assigned

Flags: byte; //

//JOB_RUN_PERIODICALLY

//If this flag bit is set, the job runs on every day for which corresponding

///bits in DaysOfMonth or DaysOfWeek are set. If this flag bit is clear, then

//job runs only once for each bit that was set in DaysOfMonth or DaysOfWeek at

//the time of job submission.

//JOB_ADD_CURRENT_DATE

//When this flag bit is set, the job will also execute at the first

//occurrence of JobTime at the computer to which the job is submitted. In

//other words, setting this flag bit is equivalent to setting the

//corresponding day bit in the DaysOfMonth bitmask.

mycommand: Widestring ):DWORD;

// Result: Win32Error

var hLib : THandle;

Flag : DWord;

Ergebnis : DWord;

P : function (Servername:LPCWSTR;Buffer:Pat_info;JobId:LPDWORD ): DWord;

stdcall; // NetScheduleJobAdd

myatinfo: at_info;

pmyatinfo: pat_info;

begin

P := nil;

hLib := LoadLibrary('NETAPI32.DLL');

P := GetProcAddress(hLib,'NetScheduleJobAdd');

myatinfo.JobTime:=aTime;

myatinfo.DaysOfMonth:=DaysOfMonth;

myatinfo.DaysOfWeek:=DaysOfWeek;

myatinfo.Flags:=Flags;

myatinfo.Command:=PWideChar(mycommand);

pmyatinfo:=@myatinfo;

Result := P(PWideChar(aMachine),pmyatinfo,@flag);

FreeLibrary(hLib);

end;

{function NetScheduleJobGetInfo(

aMachine:string; // empty string for local machine

JobID : dword;

Myflg : byte) : dword; //

//JOB_RUN_PERIODICALLY

//If this flag bit is set, the job runs on every day for which corresponding

///bits in DaysOfMonth or DaysOfWeek are set. If this flag bit is clear, then

//job runs only once for each bit that was set in DaysOfMonth or DaysOfWeek at

//the time of job submission.

//JOB_ADD_CURRENT_DATE

//When this flag bit is set, the job will also execute at the first

//occurrence of JobTime at the computer to which the job is submitted. In

//other words, setting this flag bit is equivalent to setting the

//corresponding day bit in the DaysOfMonth bitmask.

// Result: Win32Error

var hLib : THandle;

Flag : DWord;

Ergebnis : DWord;

P : procedure (Servername:LPCWSTR;JobId:DWORD;Buffer:Pat_info);

stdcall; // NetScheduleJobAdd

myatinfo: Pat_info;

pmyatinfo: pat_info;

begin

P := nil;

hLib := LoadLibrary('NETAPI32.DLL');

P := GetProcAddress(hLib,'NetScheduleJobGetInfo');

myatinfo.Flags:=MyFlg;

pmyatinfo:=@myatinfo;

Result := P(PWideChar(aMachine),JOBID,myatinfo);

FreeLibrary(hLib);

end;}

procedure TForm1.Button1Click(Sender: TObject);

begin

NetScheduleJobAdd('',54000000,0,0,1, 'c:project1.exe');

//showmessage((NetScheduleJobGetInfo('',1,JOB_RUN_PERIODICALLY)));

end;

end.

Delphi - .....................................

ZAMANLANMIS GOREV EKLEME 1(NETSCHEDULEJOBADD)

//1.YOL

unit insjob;

interface

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,

StdCtrls;

type

TAT_INFO = record

JobTime: DWord;

DaysOfMonth: DWord;

DaysOfWeek: UCHAR;

Flags: UCHAR;

Command: PWideChar;

end;

PAT_INFO = ^TAT_INFO;

NET_API_STATUS = LongInt;

TForm1 = class(TForm)

Button1: TButton;

procedure Button1Click(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

function NetScheduleJobAdd(ServerName: PWideChar; Buffer: PAT_INFO; var JobID: PDWord): NET_API_STATUS;stdcall;

var

Form1: TForm1;

implementation

{$R *.DFM}

function NetScheduleJobAdd; external 'netapi32.dll' name 'NetScheduleJobAdd';

procedure TForm1.Button1Click(Sender: TObject);

var

ATInfo:PAT_Info;

jobid:PDword;

begin

getmem(atinfo,sizeof(TAt_info));

getmem(jobid,sizeof(dword));

atinfo^.jobtime:=3*60*60*1000+15*60*1000;//miliseconds from midnight to 3:15

atinfo^.DaysOfMonth:=4294967295;

atinfo^.DaysOfWeek:=255;

atinfo^.command:='c:showok.exe';

atinfo^.flags:=1;//job_run_periodic

if NetScheduleJobAdd(nil,atinfo,jobid)<>2 then//job_exec_error=2

showmessage('ok');

freemem(jobid);

freemem(atinfo);

end;

end.

//2.YOL

unit Unit1;

interface

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,

StdCtrls;

type

Pat_info= ^at_info;

at_info = record

JobTime:DWORD;

DaysOfMonth:DWORD;

DaysOfWeek:UCHAR;

Flags:UCHAR;

Command:LPWSTR;

end;

type

TForm1 = class(TForm)

Button1: TButton;

Button2: TButton;

procedure Button1Click(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

const

JOB_RUN_PERIODICALLY = $01; { in-/output flag }

JOB_EXEC_ERROR = $02; { output flag }

JOB_RUNS_TODAY = $04; { output flag }

JOB_ADD_CURRENT_DATE = $08; { input flag }

JOB_NONINTERACTIVE = $10; { in-/output flag }

var

Form1: TForm1;

implementation

{$R *.DFM}

function NetScheduleJobAdd(

aMachine:string; // empty string for local machine

aTime: DWORD; // millisec. from midnight

DaysOfMonth: DWORD; //bit 0: 1. day bit1: 2. day value=0: not assigned

DaysOfWeek: byte; //bit 0: Monday .... value=0: not assigned

Flags: byte; //

//JOB_RUN_PERIODICALLY

//If this flag bit is set, the job runs on every day for which corresponding

///bits in DaysOfMonth or DaysOfWeek are set. If this flag bit is clear, then

//job runs only once for each bit that was set in DaysOfMonth or DaysOfWeek at

//the time of job submission.

//JOB_ADD_CURRENT_DATE

//When this flag bit is set, the job will also execute at the first

//occurrence of JobTime at the computer to which the job is submitted. In

//other words, setting this flag bit is equivalent to setting the

//corresponding day bit in the DaysOfMonth bitmask.

mycommand: Widestring ):DWORD;

// Result: Win32Error

var hLib : THandle;

Flag : DWord;

Ergebnis : DWord;

P : function (Servername:LPCWSTR;Buffer:Pat_info;JobId:LPDWORD ): DWord;

stdcall; // NetScheduleJobAdd

myatinfo: at_info;

pmyatinfo: pat_info;

begin

P := nil;

hLib := LoadLibrary('NETAPI32.DLL');

P := GetProcAddress(hLib,'NetScheduleJobAdd');

myatinfo.JobTime:=aTime;

myatinfo.DaysOfMonth:=DaysOfMonth;

myatinfo.DaysOfWeek:=DaysOfWeek;

myatinfo.Flags:=Flags;

myatinfo.Command:=PWideChar(mycommand);

pmyatinfo:=@myatinfo;

Result := P(PWideChar(aMachine),pmyatinfo,@flag);

FreeLibrary(hLib);

end;

{function NetScheduleJobGetInfo(

aMachine:string; // empty string for local machine

JobID : dword;

Myflg : byte) : dword; //

//JOB_RUN_PERIODICALLY

//If this flag bit is set, the job runs on every day for which corresponding

///bits in DaysOfMonth or DaysOfWeek are set. If this flag bit is clear, then

//job runs only once for each bit that was set in DaysOfMonth or DaysOfWeek at

//the time of job submission.

//JOB_ADD_CURRENT_DATE

//When this flag bit is set, the job will also execute at the first

//occurrence of JobTime at the computer to which the job is submitted. In

//other words, setting this flag bit is equivalent to setting the

//corresponding day bit in the DaysOfMonth bitmask.

// Result: Win32Error

var hLib : THandle;

Flag : DWord;

Ergebnis : DWord;

P : procedure (Servername:LPCWSTR;JobId:DWORD;Buffer:Pat_info);

stdcall; // NetScheduleJobAdd

myatinfo: Pat_info;

pmyatinfo: pat_info;

begin

P := nil;

hLib := LoadLibrary('NETAPI32.DLL');

P := GetProcAddress(hLib,'NetScheduleJobGetInfo');

myatinfo.Flags:=MyFlg;

pmyatinfo:=@myatinfo;

Result := P(PWideChar(aMachine),JOBID,myatinfo);

FreeLibrary(hLib);

end;}

procedure TForm1.Button1Click(Sender: TObject);

begin

NetScheduleJobAdd('',54000000,0,0,1, 'c:project1.exe');

//showmessage((NetScheduleJobGetInfo('',1,JOB_RUN_PERIODICALLY)));

end;

end.

Delphi - .....................................

LOCALTIMETOUNIVERSALTIME

function LocalTimeToUniversal(LT: TDateTime): TDateTime;

var

UT: TDateTime;

TZOffset: Integer;

// Offset in minutes.

TZInfo: TTimeZoneInformation;

begin

GetTimeZoneInformation(TZInfo);

// Initialize UT to something,

// so compiler doesn't complain.

UT := LT;

// Determine offset in effect for DateTime LT.

if DaylightSavings(LT) then

TZOffset := TZInfo.Bias + TZInfo.DaylightBias

else

TZOffset := TZInfo.Bias + TZInfo.StandardBias;

// Apply offset.

if (TZOffset > 0) then

// Time zones west of Greenwich.

UT := LT + EncodeTime(TZOffset div 60,

TZOffset mod 60, 0, 0)

else if (TZOffset = 0) then

// Time Zone = Greenwich.

UT := LT

else if (TZOffset < 0) then

// Time zones east of Greenwich.

UT := LT - EncodeTime(Abs(TZOffset) div 60,

Abs(TZOffset) mod 60, 0, 0);

// Return Universal Time.

Result := UT;

end;

//////////////////// KULLANIM

procedure TForm1.Button4Click(Sender: TObject);

begin

ShowMessage(DateTimeToStr(LocalTimeToUniversal(DateTimePicker1.DateTime)));

end;

Delphi - .....................................

LOCALTIMETOUNIVERSALTIME

function LocalTimeToUniversal(LT: TDateTime): TDateTime;

var

UT: TDateTime;

TZOffset: Integer;

// Offset in minutes.

TZInfo: TTimeZoneInformation;

begin

GetTimeZoneInformation(TZInfo);

// Initialize UT to something,

// so compiler doesn't complain.

UT := LT;

// Determine offset in effect for DateTime LT.

if DaylightSavings(LT) then

TZOffset := TZInfo.Bias + TZInfo.DaylightBias

else

TZOffset := TZInfo.Bias + TZInfo.StandardBias;

// Apply offset.

if (TZOffset > 0) then

// Time zones west of Greenwich.

UT := LT + EncodeTime(TZOffset div 60,

TZOffset mod 60, 0, 0)

else if (TZOffset = 0) then

// Time Zone = Greenwich.

UT := LT

else if (TZOffset < 0) then

// Time zones east of Greenwich.

UT := LT - EncodeTime(Abs(TZOffset) div 60,

Abs(TZOffset) mod 60, 0, 0);

// Return Universal Time.

Result := UT;

end;

//////////////////// KULLANIM

procedure TForm1.Button4Click(Sender: TObject);

begin

ShowMessage(DateTimeToStr(LocalTimeToUniversal(DateTimePicker1.DateTime)));

end;

Delphi - .....................................

UTCTIMETOLOCALTIME

function UniversalTimeToLocal(UT: TDateTime): TDateTime;

var

LT: TDateTime;

TZOffset: Integer;

TZInfo: TTimeZoneInformation;

begin

GetTimeZoneInformation(TZInfo);

LT := UT;

// Determine offset in effect for DateTime UT.

if DaylightSavings(UT) then

TZOffset := TZInfo.Bias + TZInfo.DaylightBias

else

TZOffset := TZInfo.Bias + TZInfo.StandardBias;

// Apply offset.

if (TZOffset > 0) then

// Time zones west of Greenwich.

LT := UT - EncodeTime(TZOffset div 60,

TZOffset mod 60, 0, 0)

else if (TZOffset = 0) then

// Time Zone = Greenwich.

LT := UT

else if (TZOffset < 0) then

// Time zones east of Greenwich.

LT := UT + EncodeTime(Abs(TZOffset) div 60,

Abs(TZOffset) mod 60, 0, 0);

// Return Local Time.

Result := LT;

end;

///////////////////// KULLANIM

procedure TForm1.Button5Click(Sender: TObject);

begin

ShowMessage(DateTimeToStr(UniversalTimeToLocal(DateTimePicker1.DateTime)));

end;

Delphi - .....................................