Adapter Code Delphi 7 à Delphi 2009

**mmsalem** · 17/03/2009, 19h00

Cette routine me servait autrefois de limiter l'exécution d'un logiciel sur la machine d'un utilisateur via le numéro de serie du disque physique qu'elle renvoie sous DELPHI 7 Entreprise passée sous DELPHI 2009 Architecte apparemment et dans la limite de mes connaissances aucun message que se soit n'est notifié mais la valeur de retour est une chaine vide,
la fonction GetLastError renvoie le message " Indique Deux Numéros de Version Incompatibles ".

Eclairez-moi si c'est possible.
Os Xp SP2
---------------------------------------

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
function GetIdeDiskSerialNumber : String; 
type 
  TSrbIoControl = packed record 
     HeaderLength : ULONG; 
     Signature    : Array[0..7] of Char; 
     Timeout      : ULONG; 
     ControlCode  : ULONG; 
     ReturnCode   : ULONG; 
     Length       : ULONG; 
   end; 
   SRB_IO_CONTROL = TSrbIoControl; 
   PSrbIoControl = ^TSrbIoControl; 
 
   TIDERegs = packed record 
     bFeaturesReg     : Byte; // especificar "comandos" SMART 
     bSectorCountReg  : Byte; // registro de contador de setor 
     bSectorNumberReg : Byte; // registro de número de setores 
     bCylLowReg       : Byte; // valor de cilindro (byte mais baixo) 
     bCylHighReg      : Byte; // valor de cilindro (byte mais alto) 
     bDriveHeadReg    : Byte; // registro de drive/cabeça 
     bCommandReg      : Byte; // comando IDE 
     bReserved        : Byte; // reservado- tem que ser zero 
   end; 
   IDEREGS   = TIDERegs; 
   PIDERegs  = ^TIDERegs; 
 
   TSendCmdInParams = packed record 
     cBufferSize  : DWORD; 
     irDriveRegs  : TIDERegs; 
     bDriveNumber : Byte; 
     bReserved    : Array[0..2] of Byte; 
     dwReserved   : Array[0..3] of DWORD; 
     bBuffer      : Array[0..0] of Byte; 
   end; 
   SENDCMDINPARAMS   = TSendCmdInParams; 
   PSendCmdInParams  = ^TSendCmdInParams; 
 
   TIdSector = packed record 
     wGenConfig                 : Word; 
     wNumCyls                   : Word; 
     wReserved                  : Word; 
     wNumHeads                  : Word; 
     wBytesPerTrack             : Word; 
     wBytesPerSector            : Word; 
     wSectorsPerTrack           : Word; 
     wVendorUnique              : Array[0..2] of Word; 
     sSerialNumber              : Array[0..19] of Char; 
     wBufferType                : Word; 
     wBufferSize                : Word; 
     wECCSize                   : Word; 
     sFirmwareRev               : Array[0..7] of Char; 
     sModelNumber               : Array[0..39] of Char; 
     wMoreVendorUnique          : Word; 
     wDoubleWordIO              : Word; 
     wCapabilities              : Word; 
     wReserved1                 : Word; 
     wPIOTiming                 : Word; 
     wDMATiming                 : Word; 
     wBS                        : Word; 
     wNumCurrentCyls            : Word; 
     wNumCurrentHeads           : Word; 
     wNumCurrentSectorsPerTrack : Word; 
     ulCurrentSectorCapacity    : ULONG; 
     wMultSectorStuff           : Word; 
     ulTotalAddressableSectors  : ULONG; 
     wSingleWordDMA             : Word; 
     wMultiWordDMA              : Word; 
     bReserved                  : Array[0..127] of Byte; 
   end; 
   PIdSector = ^TIdSector; 
 
const 
   IDE_ID_FUNCTION               = $EC; 
   IDENTIFY_BUFFER_SIZE          = 512; 
   DFP_RECEIVE_DRIVE_DATA        = $0007c088; 
   IOCTL_SCSI_MINIPORT           = $0004d008; 
   IOCTL_SCSI_MINIPORT_IDENTIFY  = $001b0501; 
   DataSize = sizeof(TSendCmdInParams)-1+IDENTIFY_BUFFER_SIZE; 
   BufferSize = SizeOf(SRB_IO_CONTROL)+DataSize; 
   W9xBufferSize = IDENTIFY_BUFFER_SIZE+16; 
var 
   hDevice : THandle; 
   cbBytesReturned : DWORD; 
   pInData : PSendCmdInParams; 
   pOutData : Pointer; // PSendCmdOutParams 
   Buffer : Array[0..BufferSize-1] of Byte; 
   srbControl : TSrbIoControl absolute Buffer; 
 
procedure ChangeByteOrder( var Data; Size : Integer ); 
var ptr : PChar; 
     i : Integer; 
     c : Char; 
begin 
   ptr := @Data; 
   for i := 0 to (Size shr 1)-1 do 
   begin 
     c := ptr^; 
     ptr^ := (ptr+1)^; 
     (ptr+1)^ := c; 
     Inc(ptr,2); 
   end; 
end; 
 
begin 
   Result := ''; 
   FillChar(Buffer,BufferSize,#0); 
   if Win32Platform=VER_PLATFORM_WIN32_NT then 
   // Windows NT, Windows 2000, Windows XP 
   begin 
   // recuperar handle da porta SCSI 
     hDevice := CreateFile('\\.\Scsi0:', 
     // Nota: '\\.\C:' precisa de privilégios administrativos 
     GENERIC_READ or GENERIC_WRITE, 
     FILE_SHARE_READ or FILE_SHARE_WRITE, 
     nil, OPEN_EXISTING, 0, 0); 
 
     if hDevice=INVALID_HANDLE_VALUE then Exit; 
     try 
       srbControl.HeaderLength := SizeOf(SRB_IO_CONTROL); 
       System.Move('SCSIDISK',srbControl.Signature,8); 
       srbControl.Timeout      := 2; 
       srbControl.Length       := DataSize; 
       srbControl.ControlCode  := IOCTL_SCSI_MINIPORT_IDENTIFY; 
       pInData := PSendCmdInParams(PChar(@Buffer) + SizeOf(SRB_IO_CONTROL)); 
       pOutData := pInData; 
       with pInData^ do 
       begin 
         cBufferSize  := IDENTIFY_BUFFER_SIZE; 
         bDriveNumber := 0; 
         with irDriveRegs do 
         begin 
           bFeaturesReg     := 0; 
           bSectorCountReg  := 1; 
           bSectorNumberReg := 1; 
           bCylLowReg       := 0; 
           bCylHighReg      := 0; 
           bDriveHeadReg    := $A0; 
           bCommandReg      := IDE_ID_FUNCTION; 
         end; 
       end; 
 
       if not DeviceIoControl( hDevice, IOCTL_SCSI_MINIPORT, @Buffer, BufferSize, @Buffer, BufferSize, cbBytesReturned, nil) then 
         Exit; 
       finally 
         CloseHandle(hDevice); 
       end; 
     end 
   else 
     begin 
     // Windows 95 OSR2, Windows 98, Windows ME 
     hDevice := CreateFile( '\\.\SMARTVSD', 0, 0, nil, CREATE_NEW, 0, 0 ); 
     if hDevice=INVALID_HANDLE_VALUE then Exit; 
     try 
       pInData := PSendCmdInParams(@Buffer); 
       pOutData := @pInData^.bBuffer; 
       with pInData^ do 
       begin 
         cBufferSize  := IDENTIFY_BUFFER_SIZE; 
         bDriveNumber := 0; 
         with irDriveRegs do 
         begin 
           bFeaturesReg     := 0; 
           bSectorCountReg  := 1; 
           bSectorNumberReg := 1; 
           bCylLowReg       := 0; 
           bCylHighReg      := 0; 
           bDriveHeadReg    := $A0; 
           bCommandReg      := IDE_ID_FUNCTION; 
         end; 
       end; 
 
       if not DeviceIoControl( hDevice, DFP_RECEIVE_DRIVE_DATA, 
       pInData, SizeOf(TSendCmdInParams)-1, pOutData, W9xBufferSize, cbBytesReturned, nil ) then 
         Exit; 
       finally 
         CloseHandle(hDevice); 
       end; 
     end; 
 
     with PIdSector(PChar(pOutData)+16)^ do 
     begin 
       ChangeByteOrder(sSerialNumber,SizeOf(sSerialNumber)); 
       SetString(Result,sSerialNumber,SizeOf(sSerialNumber)); 
     end; 
end;

how to call the function:
1) Create this variables:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
       s : String; 
       rc : DWORD;

2) on onClick of Event of Button, paste this code

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
     s := GetIdeDiskSerialNumber; 
     if s='' then 
     begin 
       rc := GetLastError; 
       if rc=0 then 
         showmessage('Drive IDE don´t suport SMART') 
       else 
         showmessage(SysErrorMessage(rc)); 
     end 
     else 
       showmessage('Fisical serial number disk is: ' + s);

**ShaiLeTroll** · 17/03/2009, 19h09

Ajout la balise [ CODE] (icone #), c'est illisible

Vérifie qu'elle version des API est appelé ! Ansi (A) ou Unicode (W)
Si Ansi, déjà remplace Char par AnsiChar, car Delphi 2009 est UNICODE alors que Delphi 7 est ANSI, ...
Si Wide, vérifie la taille des buffer, il faut les doubler pour prendre en compte qu'un Char c'est un UnicodeChar en fait ...

Es-tu l'auteur de ce code ?
Si oui, tu aurais pu te renseigner à ce sujet, tout le monde en parle du passage à l'UNICODE, c'est la plus grosse difficulté dans la migration pour les habitués du codage à la sauvage des API et des manipulation de chaine comme tableau de byte ... le jour où faut que j'y passe, j'espère n'avoir rien à migrer

, j'ai tellement de code sauvage ...
Si non, ben, désolé, je suis un Troll ...

ChangeByteOrder, il faut faire une différence en Size, la taille en octet du tableau de char, et Length, le nombre de caractère dans le tableau de char ... a mon avis, tu risque des violations d'accès ...

Idem, PChar, c'est PUnicodeChar par défaut maintenant, à voir avec PAnsiChar ...

**mmsalem** · 17/03/2009, 22h18

Je suis loin d'être l'auteur de ce code, j'avais meme sollicité son auteur respectif il ne m'a pas repondu, quand je ne suis pas à la hauteur de porter des correctifs à ce code, je souhaite si un averti qui use de DELPHI 2009 puisse m'epargner des experiences inutiles.
Merci Troll.

**ShaiLeTroll** · 18/03/2009, 09h55

donc, essaye un truc pour commencer, et si cela ne fonctionne pas, ben, sur le forum, tu as le même principe de protection mais via l'adresse MAC de la carte réseau ...

Transforme sauvagement
Char -> AnsiChar
PChar -> PAnsiChar
DeviceIoControl -> DeviceIoControlA

**Paul TOTH** · 18/03/2009, 11h00

Envoyé par ShaiLeTroll

donc, essaye un truc pour commencer, et si cela ne fonctionne pas, ben, sur le forum, tu as le même principe de protection mais via l'adresse MAC de la carte réseau ...

Transforme sauvagement
Char -> AnsiChar
PChar -> PAnsiChar
DeviceIoControl -> DeviceIoControlA

oui ça fonctionne, sauf que la fonction n'a pas de version A/W donc il ne faut pas changer son nom

**mmsalem** · 18/03/2009, 12h25

Salut
J'ai modifié respectivement les Types conseillés sauf la fonction DeviceIoCOntrol, DeviceIoControlA n'est declarée dans aucune unité de celles par defaut.
Resultat : ça n'a pas marché sauf que le message d'erreur recuperé dans la variable Rc a changé : " Fonction Incorrecte ".
Merci pour l'appui.

**Aka Guymelef** · 18/03/2009, 13h15

Comme le soulignais Paul Toth, DeviceIoCOntrol n'a pas de déclinaison A/W donc pour le coup il ne faut pas changer le nom de l'API.

Néanmoins en règle générale les API sont toujours distinguées entre A et W, avant D2009 c'était les A qui étaient appelées par défaut et maintenant ce sont les W.

**ShaiLeTroll** · 18/03/2009, 16h22

Envoyé par Paul TOTH

oui ça fonctionne, sauf que la fonction DeviceIoControl n'a pas de version A/W donc il ne faut pas changer son nom

Ah, effectivement, et par défaut, si c'est fonction prend des char dans des structures, par défaut c'est ANSI ?

Tu utilise FillChar pour remplir à Zéro, autant utiliser le fonction dédié pour cela ZeroMemory au cas où il y a aussi un impact A/W ...

Fait TOUTES les modifs dans Delphi 7, et une fois que cela fonctionne en D7, retente en D2009, ... sinon tu risques de débugger en D2009 ce qui ne fonctionne même plus en D7 ...

**mmsalem** · 18/03/2009, 16h51

A mon avis, aprés des tests et fouilles dans l'aide en ligne les Types : Char, PChar sont toujours d'actualité, le probleme est situé peut etre dans le gouffre des API illustrées en Anglais, là je ne m'en tire pas bien !.

**ShaiLeTroll** · 18/03/2009, 16h55

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

 System.Move('SCSIDISK',srbControl.Signature,8);

'SCSIDISK' c'est une constante chaine, du coup, elle est en quoi UnicodeString, en tout logique, remplace donc par

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
var
  SignatureText: AnsiString;
 
... 
  SignatureText := 'SCSIDISK';
  System.Move(SignatureText[1], srbControl.Signature, 8);

ou

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
const
  SignatureText: AnsiString= 'SCSIDISK'; 
 
  System.Move(SignatureText[1], srbControl.Signature, 8);

Sache que pour CreateFile, en fait maintenant tu utilises implicitement CreateFileW au lieu de CreateFileA, ce qui confirme qu'une constante chaine est une UniCodeString, et confirme ce que j'ai supposé ci-dessus

Char, PChar sont toujours d'actualité, c'est juste pas les mêmes entre D7 et D2009 ... et c'est l'ambiguité dans leur utilisation avec une API qui fonctionnait en ANSI qui nécessite de changer ces types ...

Idem entre String qui passe de AnsiString à UnicodeString, le tableau de caractère déjà lui occupe le double en espacé mémoire, mais pour aller plus loin, l'entête de la String (D7) contenait la longueur et le compteur de Référence, alors que l'entête d'une String (D2009) contient le CodePage du CharSet, indique c'est un ANSI ou UNICODE, le compteur de ref et la taille, ...

Sinon, normalement, PhysicalDrive0 que l'on utilise de façon générique (IDE, SCSI, ATA, RAID, ...), car Scsi0, c'est un cas particulier, ...

Ensuite SetString, hum, ... idem, c'est ambigue ...

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

function GetIdeDiskSerialNumber : AnsiString;

**Paul TOTH** · 18/03/2009, 17h27

oups, en effet j'avais oublié cette modification

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
 
 srbControl.Signature := 'SCSIDISK';

tout bêtement

**ShaiLeTroll** · 18/03/2009, 17h35

Ouh, je n'ai pas osé le proposer, si en D7, cela me semble évident, en D2009, je préférais laisser le move ... mais bénéficier de l'astuce pascal sur l'assimilation "array of char" et constante chaine ...

d'ailleurs, Paul, la ShortString est devenu quoi (je n'ai eu le temps pas de testé D2009, j'ai de la théorie, mais cela conduit au choas en pratique) ? un UnicodeShortString ou il l'ont laissé comme avant ? type pas très utilisé sauf dans le truc de base comme TObject.ClassName ou lorsque l'on est flémard pour un buffer PChar avec une API

**Paul TOTH** · 18/03/2009, 17h42

ShortString n'a pas bougé lui

Adapter Code Delphi 7 à Delphi 2009

API, COM et SDKs Delphi

Discussions similaires

Partager

Partager