Programlama yapalım ve Öğrenelim.

Program Çalışırken Kod İle Veritabanı Yaratmak (DBASE - ASCII - MSACCESS [*.mdb])

// Delphi programcılığndan daha çok programlama ile uraşan arkadaşlarda bilirlerki

//yazılan bir programda her ne kadar hali hazırda yapılmış bir veritabanını kullansakta

// bazı zamanlar programın içinden kendi veritabanımızı oluşturma gereksinimi duyarız.

//bunu kodbankta araştırdım ama bulamadım.bu yüzdende kendim bişiler yapabilirmiyim diye

//biraz uğraştım vede aşağıdaki kodlar ortaya çıktı.

//umarım bir arkadaşımızın işine yarar.Bol procedur le başlayan end ile sonlanan kodlar dileğiyle

uses

ComObj;

// ADOX ile yaratmak

function mdbyarat(FileName: string): string;

var

cat: OLEVariant;

begin

Result := '';

try

cat := CreateOleObject('ADOX.Catalog');

cat.Create('Provider=Microsoft.Jet.OLEDB.4.0;Data Source=' + FileName + ';');

cat := NULL;

except

on e: Exception do Result := e.message;

end;

procedure TForm1.Button1Click(Sender: TObject);

begin

mdbyarat('c:Testdb.mdb');

end;

//Sadece DBASE yada ASCII veritabanı yaratmak istiyorsanız

procedure CreateATable(DBName, //Alias yada dizin

TblName : String); //Yarataılacak Tablo Adı

TblType : TTableType); //ttDefault, ttParadox, ttDBase, ttASCII (tablo türü)

var

tablo : TTable;

begin

tablo := TTable.Create(Application);

with tbl do begin

Active := False;

DatabaseName := DBName;

TableName := TblName;

TableType := TblType;

with FieldDefs do begin

Clear;

Add('Soyadi', ftString, 30, False); //30 değeri alanın uzunluğu [ftString değeri de alanın string tipinde olacağıdır]

Add('Adi', ftString, 30, False);

Add('Adres1', ftString, 40, False);

Add('Adres2', ftString, 40, False);

Add('Sehir', ftString, 30, False);

Add('Cad', ftString, 2, False);

Add('Alan_Kodu', ftString, 10, False);

end;

{Tabloya birincil anahtar ekle}

with IndexDefs do begin

Clear;

Add('Field1Index', 'Soyadi;Adi', [ixPrimary, ixUnique]); {bunu istediğiniz bir alan olarak atayabilirsiniz}

end;

CreateTable; {Tabloyu Yarat}

end;

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

FİLE TRANSFER SERVER ve CLİENT

/// BU KISIM Gönderici tarafını dinler gelen paketleri toplayıp belirlediğiniz dizine kopyalar

///Clientide aşağıdadır dosya transferi çok yüksek hızdadır

///şu ana kadar gördüğüm en hızlı dosya gönderici ve alıcıdır

/// Hiçbir zamazingo componente ihtiyaç duyulmaz

/// **********************COMMANDX ***************************

***********************SERVER KISMI************************************

unit mainsrvr;

interface

uses

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

ComCtrls, StdCtrls, Buttons, ScktComp;

type

TFileInfo = packed record

FileLength : Integer;

FileName : string[128];

end;

TFileServer = class(TForm)

LabPort: TLabel;

EdPort: TEdit;

EdDir: TEdit;

LabDir: TLabel;

Statbar: TStatusBar;

ServerSocket: TServerSocket;

BtnListen: TButton;

BtnStopListen: TButton;

procedure BtnListenClick(Sender: TObject);

procedure BtnStopListenClick(Sender: TObject);

procedure ServerSocketGetThread(Sender: TObject;

ClientSocket: TServerClientWinSocket;

var SocketThread: TServerClientThread);

private

{ Private declarations }

public

end;

{

This thread is executed by the server for each client connection

}

TServerRcvThread = class(TServerClientThread)

private

FStatus : string;

FDir : string;

protected

procedure ClientExecute; override;

public

procedure SetStatus;

property Dir : string read FDir write FDir;

end;

var

FileServer : TFileServer;

implementation

{$R *.DFM}

{

User has clicked "Listen" button.

Activate server's listening socket on cpecified port.

}

procedure TFileServer.BtnListenClick(Sender: TObject);

begin

ServerSocket.ServerType := stThreadBlocking;

ServerSocket.Port := StrToInt( EdPort.Text );

ServerSocket.Active := True;

BtnListen.Enabled := not ServerSocket.Active;

BtnStopListen.Enabled := ServerSocket.Active

end;

{

User has clicked "Stop Listening" button

}

procedure TFileServer.BtnStopListenClick(Sender: TObject);

begin

ServerSocket.Active := False;

BtnListen.Enabled := not ServerSocket.Active;

BtnStopListen.Enabled := ServerSocket.Active

end;

{

OnGetThread handler for TServerSocket

The server is blocking, hence creates new thread for each client connection.

Here I force the server to use my own thread class instead of standard one.

}

procedure TFileServer.ServerSocketGetThread(Sender: TObject;

ClientSocket: TServerClientWinSocket;

var SocketThread: TServerClientThread);

begin

// Create new thread (a descendant of TServerClientThread)

// The thred is created in suspended state, to set up

// Dir property before execution starts actually.

SocketThread := TServerRcvThread.Create( True, ClientSocket );

// Save target directory into thread's property

// (to use it within a thread).

TServerRcvThread(SocketThread).Dir := EdDir.Text;

SocketThread.Resume;

end;

{ TServerRcvThread }

{

TServerRcvThread thread procedure.

Its execution begins immediately after the server creates client's

thread in OnGetThreadHandler;

}

procedure TServerRcvThread.ClientExecute;

var

SockStream : TWinSocketStream;

FileInfo : TFileInfo;

FileStream : TFileStream;

RcvBuf : array[0..255] of Byte;

nRead : Integer;

nToRead : Integer;

nTotal : Integer;

begin

FStatus := 'Unknown error';

// Prepare blocking stream socket

SockStream := TWinSocketStream.Create( ClientSocket, 10000 );

try

// Wait until data becomes available at our endpoint.

if SockStream.WaitForData(1000) then begin

// Read info header

nRead := SockStream.Read( FileInfo, SizeOf(FileInfo) );

if (nRead = SizeOf(FileInfo)) then begin

// Prepare destination file

nTotal := 0;

FileStream := TFileStream.Create( FDir + '' + FileInfo.FileName,

fmCreate );

try

// Read file body by realatively small blocks

while(nTotal < FileInfo.FileLength) do begin

// How many bytes shall we read?

nToRead := (FileInfo.FileLength - nTotal);

if (nToRead > SizeOf(RcvBuf)) then

nToRead := SizeOf(RcvBuf);

// Read from blocking socket

nRead := SockStream.Read( RcvBuf, nToRead );

if (nRead = 0) then Exit; // timeout error

nTotal := nTotal + nRead;

// Store next received chunk in the destination file

FileStream.Write( RcvBuf, nRead );

end;

finally

FileStream.Free;

end;

// Determine final status of the transfer operation

if (nTotal = FileInfo.FileLength) then

FStatus := 'File ' + FileInfo.FileName + ' received ('

+ IntToStr(nTotal) + ' bytes)'

else

FStatus := 'File ' + FileInfo.FileName + ' error ('

+ IntToStr(nTotal) + ' bytes)';

end

// could not even receive a file info header

else

FStatus := 'File info header error';

end

// No incoming data detected - abort connection.

else begin

FStatus := 'Client delay error';

ClientSocket.Close; // causes "server aborted

Terminate; // connection" on client's side

end;

finally

SockStream.Free;

Synchronize( SetStatus ); // display transfer status

end;

procedure TServerRcvThread.SetStatus;

begin

FileServer.StatBar.SimpleText := FStatus;

end;

end.

*************************** CLİENT KISMI*****************************

unit mainclnt;

interface

uses

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

ComCtrls, StdCtrls, Buttons, ScktComp;

type

TFileClient = class(TForm)

EdAddress: TEdit;

LabAddr: TLabel;

LabPort: TLabel;

EdPort: TEdit;

EdFile: TEdit;

LabFile: TLabel;

BtnTransfer: TButton;

Statbar: TStatusBar;

ClientSocket: TClientSocket;

procedure BtnTransferClick(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

TFileInfo = packed record

FileLength : Integer;

FileName : string[128];

end;

var

FileClient: TFileClient;

implementation

{$R *.DFM}

{

User clicked "Transfer" button.

Try to connect to specified server and transfer specified file.

}

procedure TFileClient.BtnTransferClick(Sender: TObject);

var

SockStream : TWinSocketStream;

FileStream : TFileStream;

FileInfo : TFileInfo;

BytesSent : Longint;

begin

try

// Prepare source file to transfer

FileStream := TFileStream.Create( EdFile.Text, fmOpenRead );

try

FileInfo.FileLength := FileStream.Size;

FileInfo.FileName := ExtractFileName( EdFile.Text );

// Prepare socket

with ClientSocket do begin

ClientType := ctBlocking;

Address := EdAddress.Text;

Port := StrToInt( EdPort.Text );

end;

// Connect to server

ClientSocket.Open();

try

// Perpeare socket stream

SockStream :=TWinSocketStream.Create( ClientSocket.Socket, 60000 );

try

// Transfer info header

BytesSent := SockStream.Write( FileInfo, SizeOf(FileInfo) );

// Transfer file body

if (BytesSent <> 0) then begin

BytesSent := SockStream.CopyFrom( FileStream, FileStream.Size );

Statbar.SimpleText := 'Transferred ' + IntToStr( BytesSent )

+ ' from ' + FileInfo.FileName;

end

else

Statbar.SimpleText := 'Header transfer error';

finally

SockStream.Free;

end;

finally

// Disconnect from server

ClientSocket.Close();

end;

finally

FileStream.Free;

end;

except

On E : Exception do

Statbar.SimpleText := E.Message;

end;

end.

//////// COMMANDX///*******************

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

windows,winsvc; nt service, driver; install, stop, remove. bol şanslar.... ROOTKIT {örnek}

unit Unit1;

interface

uses

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

Dialogs,StdCtrls

ddkint;

type

TForm1 = class(TForm)

yukle: TButton;

calistir: TButton;

durdur: TButton;

sil: TButton;

Memo1: TMemo;

procedure yukleClick(Sender: TObject);

procedure calistirClick(Sender: TObject);

procedure durdurClick(Sender: TObject);

procedure silClick(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.yukleClick(Sender: TObject);

begin

memo1.Lines.add('Yüleme durumu: '+messagestring(

driverinstall('c:','uygulama.exe')//uygulama.sys, *.vxd, *.dll, *.ocx

))

end;

procedure TForm1.calistirClick(Sender: TObject);

begin

memo1.Lines.add('Çalıştırma durumu: '+messagestring(

driverstart('uygulama.exe')//uygulama.sys, *.vxd, *.dll, *.ocx

))

end;

procedure TForm1.durdurClick(Sender: TObject);

begin

memo1.Lines.add('Durdurma durumu: '+messagestring(

driverstop('uygulama.exe')//uygulama.sys, *.vxd, *.dll, *.ocx

))

end;

procedure TForm1.silClick(Sender: TObject);

begin

memo1.Lines.add('Silme durumu: '+messagestring(

driverremove('uygulama.exe')//uygulama.sys, *.vxd, *.dll, *.ocx

))

end;

end.

//düşmanınızın "anasını ağlatın" ! bol şanslar

//mail:themrigi@yahoo.com

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

Keygen Nasıl yazılıyor?

How to make key generators?

-===========================-

Introduction

------------

I take no responsibility of the usage of this information.

This tutorial, is for educational knowledge ONLY.

Hi there, in this tutorial, I intend to teach you how to make a pretty

simple keygen, of a program called W3Filer 32 V1.1.3.

W3Filer is a pretty good web downloader...

I guess some of you might know the program.

I`ll assume you know:

A.How to use debugger (in this case, SoftIce).

B.How to crack, generally (finding protection routines,patching them,etc...).

C.How to use Disassembler (This knowledge can help).

D.Assembly.

E.How to code in Turbo Pascal (tm).

Tools you`ll need:

A.SoftIce 3.00/01 or newer.

B.WD32Asm. (Not a must).

C.The program W3Filer V1.13 (if not provided in this package), can be found in

www.windows95.com I believe.

D.Turbo Pascal (ANY version).

Well, enough blah blah, let's go cracking...

Run W3Filer 32.

A nag screen pops, and , demands registration (Hmm, this sux ;-)) Now,

We notice this program has some kind of serial number (Mine is 873977046),

Let's keep the serial in mind, I bet we`ll meet it again while we're on

the debugger.

Well, now, let's put your name and a dummy reg code...

set a BP on GetDlgItemTextA, and, press OK.

We pop inside GetDlgItemTextA, Lets find the registration routine...

I`ll save you the work, the registration routine is this:

:00404DB2 8D95A8FAFFFF lea edx, dword ptr [ebp+FFFFFAA8]

:00404DB8 52 push edx ---> Your user name here.

:00404DB9 E80B550000 call 0040A2C9 ---> Registration routine.

:00404DBE 83C408 add esp, 00000008 ---> Dunno exactly what is it.

:00404DC1 85C0 test eax, eax ---> Boolean identifier, 0 if

:00404DC3 7D17 jge 00404DDC ---> registration failed, 1 if

OK.

Well, Let's enter the CALL 40A2C9, and see what's inside it:

(Please read my comments in the code).

* Referenced by a CALL at Addresses:

|:00404DB9 , :00407F76

:0040A2C9 55 push ebp

:0040A2CA 8BEC mov ebp, esp

:0040A2CC 81C4B0FEFFFF add esp, FFFFFEB0

:0040A2D2 53 push ebx

:0040A2D3 56 push esi

:0040A2D4 57 push edi

:0040A2D5 8B5508 mov edx, dword ptr [ebp+08]

:0040A2D8 8DB500FFFFFF lea esi, dword ptr [ebp+FFFFFF00]

:0040A2DE 33C0 xor eax, eax

:0040A2E0 EB16 jmp 0040A2F8

* Referenced by a (U)nconditional or (C)onditional Jump at Address:

|:0040A2FB(C)

:0040A2E2 0FBE0A movsx ecx, byte ptr [edx] ----> Here Starts the

interesting part.

:0040A2E5 83F920 cmp ecx, 00000020 ----> ECX is the the current

char in the user name, Hmm, 20h=' '...

:0040A2E8 740D je 0040A2F7 ----> Let's see,

:0040A2EA 8A0A mov cl, byte ptr [edx] ----> Generally, all this loop

does, is copying

the user name from

[EDX], to [ESI], WITHOUT the spaces!

(Keep this in mind! ).

:0040A2EC 880C06 mov byte ptr [esi+eax], cl

:0040A2EF 42 inc edx

:0040A2F0 40 inc eax

:0040A2F1 C6040600 mov byte ptr [esi+eax], 00

:0040A2F5 EB01 jmp 0040A2F8

* Referenced by a (U)nconditional or (C)onditional Jump at Address:

|:0040A2E8(C)

:0040A2F7 42 inc edx

* Referenced by a (U)nconditional or (C)onditional Jump at Addresses:

|:0040A2E0(U), :0040A2F5(U)

:0040A2F8 803A00 cmp byte ptr [edx], 00

:0040A2FB 75E5 jne 0040A2E2 ----------------> This is the loop , we got

what it does,

Let's continue tracing

the code...

:0040A2FD 56 push esi --------> The user name is pushed, in order

Upcase it's chars.

* Reference To: USER32.CharUpperA, Ord:0000h

:0040A2FE E80F330000 Call User!CharUpper ---> After this, our name is in

upper case.

:0040A303 56 push esi -----> Our name in upper case here.

* Reference To: cw3220mt._strlen, Ord:0000h

:0040A304 E86F300000 Call 0040D378 ---> This is the length of our name.

:0040A309 59 pop ecx

:0040A30A 8BC8 mov ecx, eax ---> ECX=Length.

:0040A30C 83F904 cmp ecx, 00000004 ---> Length>=4 (MUST).

:0040A30F 7D05 jge 0040A316 ---> Let's go to this address...

:0040A311 83C8FF or eax, FFFFFFFF

:0040A314 EB67 jmp 0040A37D

* Referenced by a (U)nconditional or (C)onditional Jump at Address:

|:0040A30F(C)

:0040A316 33D2 xor edx, edx

:0040A318 33C0 xor eax, eax

:0040A31A 3BC8 cmp ecx, eax

:0040A31C 7E17 jle 0040A335 ---> (Not important, just another useless

checking).

===================================================================================

============ FROM HERE AND ON, THE IMPORTANT CODE, PAY ATTENTION ==================

===================================================================================

One thing before we continue, EDX = 00000000h as we enter to the next instructions.

* Referenced by a (U)nconditional or (C)onditional Jump at Address:

|:0040A333(C)

:0040A31E 0FBE1C06 movsx ebx, byte ptr [esi+eax] ---> EBX <--- char in user

name, offset EAX.

:0040A322 C1E303 shl ebx, 03 -----> Hmm, it shl's the char by 03h...

(Remember that).

:0040A325 0FBE3C06 movsx edi, byte ptr [esi+eax] ---> Now EDI <--- Char in

user name , offset EAX.

:0040A329 0FAFF8 imul edi, eax -----> It multiplies the char by the

offset in user name! (Remember that).

:0040A32C 03DF add ebx, edi -----> Adds the result to EBX (That was

Shelled (Ding Dong =)).

:0040A32E 03D3 add edx, ebx -----> EDX=EDX+EBX!!! - This is the CORE

of this registration routine!!!

:0040A330 40 inc eax -----> Increase EAX by one (next char).

:0040A331 3BC8 cmp ecx, eax

:0040A333 7FE9 jg 0040A31E ----> If ECX<EAX then, we leave the

loop.

* Referenced by a (U)nconditional or (C)onditional Jump at Address:

|:0040A31C(C)

:0040A335 A120674100 mov eax, dword ptr [00416720] ---> HMMMMMM, What's in

here?????

:0040A33A C1F803 sar eax, 03 ---------> WAIT! Please type in SIce '?

EAX'

Does this number in EAX look

familiar to us?

If you still don`t understand,

than, It's

our SERIAL NUMBER! (PLEASE, take

your time, and check by

yourself - don`t trust me!). OK,

so now we know,

That it SHR's EAX by 03 (SAR is

almost identical to SHR).

:0040A33D 03D0 add edx, eax ---------> Hmm, it adds the result from the

loop, the serial number shr'd by 03h

:0040A33F 52 push edx -------> Let's continue. (At this point, I

can tell you , the reg number, is

in EDX - only that the reg number

is in HEX --> That's how you enter it).

* Possible StringData Ref from Data Obj ->"%lx"

:0040A340 685EF54000 push 0040F55E

:0040A345 8D95B0FEFFFF lea edx, dword ptr [ebp+FFFFFEB0]

:0040A34B 52 push edx

* Reference To: USER32.wsprintfA, Ord:0000h

:0040A34C E8E5320000 Call 0040D636 -------> This one, does HEX2STR (Takes

the value from EDX, and turns it to an hex string).

:0040A351 83C40C add esp, 0000000C

:0040A354 8D8DB0FEFFFF lea ecx, dword ptr [ebp+FFFFFEB0] -----> type 'd ecx' -

THIS is the reg number! That's enough for us, the rest of

the code, is

just for comparing the correct reg code with ours.

:0040A35A 51 push ecx

* Reference To: USER32.CharLowerA, Ord:0000h

:0040A35B E8B8320000 Call 0040D618

:0040A360 8D85B0FEFFFF lea eax, dword ptr [ebp+FFFFFEB0]

:0040A366 50 push eax

:0040A367 FF750C push [ebp+0C]

* Reference To: cw3220mt._strcmp, Ord:0000h

:0040A36A E875300000 Call 0040D3E4

:0040A36F 83C408 add esp, 00000008

:0040A372 85C0 test eax, eax

:0040A374 7405 je 0040A37B

:0040A376 83C8FF or eax, FFFFFFFF

:0040A379 EB02 jmp 0040A37D

* Referenced by a (U)nconditional or (C)onditional Jump at Address:

|:0040A374(C)

:0040A37B 33C0 xor eax, eax

* Referenced by a (U)nconditional or (C)onditional Jump at Addresses:

|:0040A314(U), :0040A379(U)

:0040A37D 5F pop edi

:0040A37E 5E pop esi

:0040A37F 5B pop ebx

:0040A380 8BE5 mov esp, ebp

:0040A382 5D pop ebp

:0040A383 C3 ret

Making the actual Keygen

~~~~~~~~~~~~~~~~~~~~~~~~

Now, after I've explained how does the program calculate the registration

code, you can either write your own keymaker, without looking at my code, or

look at my code (in Turbo Pascal - sorry for all you C lovers ;-) Next time).

That's it, here's the source of my keygen:

------------------- Cut here ---------------------------------------------

Program W3FilerKeygen;

var

Key,SerialNum,EB,ED,digit:Longint;

I,x:Byte;

Name,KeyHex:String;

begin

Writeln(' W3Filer32 V1.1.3 Keymaker');

writeln('Cracked by ^pain^ ''97 / Rebels!');

Write('Your Name:'); { Read the name }

readln(Name);

Write('Serial Number:');

readln(SerialNum); {Yes, we need the serial number for the calculation!}

Key:=0;

x:=0;

For I:=1 to length(Name) do

begin

Name[I]:=upcase(Name[i]);

If Name[I]<>' ' then begin

eb:=ord(Name[I]) shl 3; {EB = Name[I] Shl 03h}

Ed:=ord(Name[I]); {ED = Name[I]}

ed:=ed*(x); {ED=ED*Offset}

inc(x);

eb:=eb+ed; {Add ED to EB}

Key:=Key+EB; {Add EB to KEY}

end;

Key:=Key+(SerialNum shr 3); { Add SerialNum shr 03h to Key}

{ From here, this is just HEX2STRING --> I`m quite sure it's

Self explaintory, else - go and learn number bases again! }

KeyHex:='';

repeat

digit:=Key mod 16;

key:=key div 16;

If digit<10 then KeyHex:=Chr(Digit+ord('0'))+KeyHex;

If digit>10 then KeyHex:=Chr(Digit-10+ord('a'))+KeyHex;

until key=0;

writeln('Your Key:',KeyHex);

writeln(' Enjoy!');

end.

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

windows,winsvc; nt service, driver; install, stop, remove. bol şanslar.... ROOTKIT

{ -----------------------------------------------------------------------------}

{ This unit can be freely used and distributed in commercial and private }

{ environments, provided this notice is not modified in any way. }

{ -----------------------------------------------------------------------------}

{ Feel free to contact me if you have any questions, comments or suggestions at}

{ zal@specosoft.com (Zloba Alexander) }

{ You can always find the latest version of this unit at: }

{ http://www.specosoft.com }

{ -----------------------------------------------------------------------------}

{ Date last modified: 08/10/2001 }

{ -----------------------------------------------------------------------------}

{ Description: }

{ This unit include service function to work with NT drivers and some }

{ constant from ntddk.h }

{------------------------------------------------------------------------------}

{ Revision History: }

{ 1.00: + First public release }

{ 1.10: + added compiler directives for correct compilation }

{ 1.20: + optimized code }

{ 1.30: + added constant for compatibility with delphi 3.0 }

{------------------------------------------------------------------------------}

{$A-,H-}

unit ddkint;

interface

uses windows,winsvc;

function CTL_CODE(const DeviceType,Func,Method,Access:Cardinal):cardinal;

const

FILE_DEVICE_BEEP = $00000001;

FILE_DEVICE_CD_ROM = $00000002;

FILE_DEVICE_CD_ROM_FILE_SYSTEM = $00000003;

FILE_DEVICE_CONTROLLER = $00000004;

FILE_DEVICE_DATALINK = $00000005;

FILE_DEVICE_DFS = $00000006;

FILE_DEVICE_DISK = $00000007;

FILE_DEVICE_DISK_FILE_SYSTEM = $00000008;

FILE_DEVICE_FILE_SYSTEM = $00000009;

FILE_DEVICE_INPORT_PORT = $0000000a;

FILE_DEVICE_KEYBOARD = $0000000b;

FILE_DEVICE_MAILSLOT = $0000000c;

FILE_DEVICE_MIDI_IN = $0000000d;

FILE_DEVICE_MIDI_OUT = $0000000e;

FILE_DEVICE_MOUSE = $0000000f;

FILE_DEVICE_MULTI_UNC_PROVIDER = $00000010;

FILE_DEVICE_NAMED_PIPE = $00000011;

FILE_DEVICE_NETWORK = $00000012;

FILE_DEVICE_NETWORK_BROWSER = $00000013;

FILE_DEVICE_NETWORK_FILE_SYSTEM= $00000014;

FILE_DEVICE_NULL = $00000015;

FILE_DEVICE_PARALLEL_PORT = $00000016;

FILE_DEVICE_PHYSICAL_NETCARD = $00000017;

FILE_DEVICE_PRINTER = $00000018;

FILE_DEVICE_SCANNER = $00000019;

FILE_DEVICE_SERIAL_MOUSE_PORT = $0000001a;

FILE_DEVICE_SERIAL_PORT = $0000001b;

FILE_DEVICE_SCREEN = $0000001c;

FILE_DEVICE_SOUND = $0000001d;

FILE_DEVICE_STREAMS = $0000001e;

FILE_DEVICE_TAPE = $0000001f;

FILE_DEVICE_TAPE_FILE_SYSTEM = $00000020;

FILE_DEVICE_TRANSPORT = $00000021;

FILE_DEVICE_UNKNOWN = $00000022;

FILE_DEVICE_VIDEO = $00000023;

FILE_DEVICE_VIRTUAL_DISK = $00000024;

FILE_DEVICE_WAVE_IN = $00000025;

FILE_DEVICE_WAVE_OUT = $00000026;

FILE_DEVICE_8042_PORT = $00000027;

FILE_DEVICE_NETWORK_REDIRECTOR = $00000028;

FILE_DEVICE_BATTERY = $00000029;

FILE_DEVICE_BUS_EXTENDER = $0000002a;

FILE_DEVICE_MODEM = $0000002b;

FILE_DEVICE_VDM = $0000002c;

FILE_DEVICE_MASS_STORAGE = $0000002d;

FILE_DEVICE_SMB = $0000002e;

FILE_DEVICE_KS = $0000002f;

FILE_DEVICE_CHANGER = $00000030;

FILE_DEVICE_SMARTCARD = $00000031;

FILE_DEVICE_ACPI = $00000032;

FILE_DEVICE_DVD = $00000033;

FILE_DEVICE_FULLSCREEN_VIDEO = $00000034;

FILE_DEVICE_DFS_FILE_SYSTEM = $00000035;

FILE_DEVICE_DFS_VOLUME = $00000036;

FILE_DEVICE_SERENUM = $00000037;

FILE_DEVICE_TERMSRV = $00000038;

FILE_DEVICE_KSEC = $00000039;

FILE_DEVICE_KRNLDRVR = $80ff;

METHOD_BUFFERED = 0;

METHOD_IN_DIRECT = 1;

METHOD_OUT_DIRECT = 2;

METHOD_NEITHER = 3;

FILE_ANY_ACCESS = 0;

FILE_SPECIAL_ACCESS = (FILE_ANY_ACCESS);

FILE_READ_ACCESS = ( $0001 ); // file & pipe

FILE_WRITE_ACCESS = ( $0002 ); // file & pipe

{$IFDEF VER100 or VER110}

// for compatibilty with delphi 3.0

const

SERVICE_KERNEL_DRIVER = $00000001;

SERVICE_DEMAND_START = $00000003;

SERVICE_ERROR_NORMAL = $00000001;

{$ENDIF}

function driverstart(const name:pchar):integer;

function driverstop(const name:pchar):integer;

// for this function must have Administrators or Power users rigths

function driverinstall(const path,name:pchar):integer;

function driverremove(const name:pchar):integer;

// exlpanation function

function messagestring(const error:integer):string;

implementation

function CTL_CODE(const DeviceType,Func,Method,Access:Cardinal):cardinal;

begin

Result := DeviceType shl 16 or Access shl 14 or Func shl 2 or Method;

end;

function driverinstall(const path,name:pchar):integer;

var hService: SC_HANDLE;

hSCMan : SC_HANDLE;

begin

Result := 0;

hSCMan := OpenSCManager(nil, nil, SC_MANAGER_ALL_ACCESS);

if hSCMan = 0 then begin

result := getlasterror;

exit;

end;

hService := CreateService(hSCMan, name,name,

SERVICE_ALL_ACCESS, SERVICE_KERNEL_DRIVER, SERVICE_DEMAND_START,

SERVICE_ERROR_NORMAL, path,

nil, nil, nil, nil, nil);

if (hService = 0) then begin

result := getlasterror;

CloseServiceHandle(hSCMan);

exit;

end

else

CloseServiceHandle(hService);

CloseServiceHandle(hSCMan);

end;

function driverstart(const name:pchar):integer;

var

hService: SC_HANDLE;

hSCMan : SC_HANDLE;

args:pchar;

begin

hSCMan := OpenSCManager(nil, nil, SC_MANAGER_CONNECT);

if hSCMan = 0 then begin

result := getlasterror;

exit;

end;

// get a handle to the service

hService := OpenService(hSCMan, name, SERVICE_START);

if hService <> 0 then Begin

// start the driver

args := nil;

Result := 0;

if integer(StartService(hService, 0, args ))=0 then

result := getlasterror;

CloseServiceHandle(hService);

end

else

result := getlasterror;

CloseServiceHandle(hSCMan);

end;

function driverstop(const name:pchar):integer;

Var

serviceStatus: TServiceStatus;

hService: SC_HANDLE;

hSCMan : SC_HANDLE;

begin

hSCMan := OpenSCManager(nil, nil, SC_MANAGER_CONNECT);

if hSCMan = 0 then begin

result := getlasterror;

exit;

end;

// get a handle to the service

hService := OpenService(hSCMan, Name, SERVICE_STOP);

if hService <> 0 then Begin

// start the driver

Result := 0;

if integer(ControlService(hService, SERVICE_CONTROL_STOP, serviceStatus))=0 then

result := getlasterror;

CloseServiceHandle(hService);

end

else

result := getlasterror;

CloseServiceHandle(hSCMan);

end;

function driverremove(const name:pchar):integer;

Var

hService: SC_HANDLE;

hSCMan : SC_HANDLE;

begin

hSCMan := OpenSCManager(nil, nil, SC_MANAGER_ALL_ACCESS);

if hSCMan = 0 then begin

result := getlasterror;

exit;

end;

// get a handle to the service

hService := OpenService(hSCMan, Name, SERVICE_ALL_ACCESS);

if hService <> 0 then Begin

// remove driver description from the registry

Result := 0;

if integer(DeleteService(hService)) = 0 then

result := getlasterror;

CloseServiceHandle(hService);

end

else

result := getlasterror;

CloseServiceHandle(hSCMan);

end;

function messagestring(const error:integer):string;

var p:pchar;

begin

GetMem(p, 200);

FillChar(p^, 200, 0);

formatmessage(FORMAT_MESSAGE_FROM_SYSTEM,nil,error,0,p,199,nil);

Result := p;

freemem(p,200);

end;

end.

//mail:themrigi@yahoo.com - ilhan

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