visitor (0 QPoints)
  • FR
  • EN
  • NL
  • DE
  • ES
315 experts, 1193 registered users, 1659 questions already answered
European Experts Exchange, the very best site for high-quality IT solutions

New Improved Search!

 


05/10/2011 1h30 : Steve Jobs is dead, the father of Apple ][ is gone, we are all orphaned.

Languages :: Pascal :: How to put an anchor for security purposes in system? (CopyProtection)


By: Okey U.S.A.  Date: 10/05/2003 00:00:00  English  Points: 20 Status: Answered
Quality : Excellent
Can Someone explain me a way to put an Anchor into System?
I wannted to put a copy protection to my proggys!
By: VGR Date: 10/05/2003 04:55:00 English  Type : Comment
not understood

System is the standard runtime library of all Pascals, an "anchor" I know only for boats and HTML
By: Okey Date: 10/05/2003 06:00:00 English  Type : Comment
I wanted to drop something like an achor into a PC system (not the unit) so that i could recognize if a program has been used without the option to delete this mark or better anchor without reformating the whole PC!
By: Okey Date: 10/05/2003 06:01:00 English  Type : Comment
One shouldn't be able to delete this mark where I want to store trial usage count information
By: dbrunton Date: 10/05/2003 06:10:00 English  Type : Comment
Well, there's no way to do what you want satisfactorily.

Various methods exist but all have been cracked. These include

embeddding an expiry date within the code and checking against the time on the computer.
using the registry to store information but in a non-standard place
using a hidden file somewhere
By: VGR Date: 10/05/2003 06:34:00 English  Type : Comment
cracking an auto-modificable program would be harder

I solved the trick by tighly linking the program to the installation it is forst put in (machine, disk, volume, username, computername, etc) and by refusing to work outside of this environment (thus preventing copy or resell of program but also move of program between disks)
Of course, I allow a certain number of "licit changes" ; those are handled under the control of MY server, accessed by the program via HTTP
By: Okey Date: 11/05/2003 19:43:00 English  Type : Comment
Hmmhh.... = = = = =@:D> ...

Well, selfmodifying software sounds great,
but on what base to recognize a PC-System and how to check if it is an allowed one or not?

Is their something working in one step!


So I thought about....

and :

I think I'll overwrite the checking routine so that it does something different later.

I'm doing a lot of reverse engineering and I know tricks for cracking ugh ....




But how can I recognize a system?
By: Okey Date: 11/05/2003 19:49:00 English  Type : Comment
An Old Win 3.11 or so proggy from ??? writes a bad sektor where it stores only one times a recognizeable anchor!

Fat32 and direct IO is all you need for!

Verry powerful!

But how to do this today with .../Win-...98/2000/NT/XP/...
By: VGR Date: 11/05/2003 21:27:00 English  Type : Comment
to identify a PC, you may use (not exhaustive)
-COMPUTERNAME
-HDrive VolumeID
-IP@ or range
By: Okey Date: 12/05/2003 20:38:00 English  Type : Comment
Hey VGR,
can you please post a little routine for each of the three sollutions about how to access this?
By: VGR Date: 12/05/2003 22:55:00 English  Type : Comment
yes yes yes

delphi ok ?

I think on some platforms COMPUTERNAME is an environment variable ;-)
By: Okey Date: 13/05/2003 20:41:00 English  Type : Comment
I'm not verry known in Delphi so a complete Routine please,


somehow I don't understand the api conflications and so on!
By: VGR Date: 13/05/2003 20:52:00 English  Type : Answer
I've a lot of different ways to do this.
I'll list them below, make your choice ;-)
1) GetVolumeID in PHP
<?php
//
// getvolumeID.php : get any volumeID
//
//VGR10042003
//
$drive='C:'; // adapt to your needs
// prepare command
$syscmd="dir $drive";
// execute, get results
$fp=popen($syscmd,'r');
if ($fp) { // ok
// read
$continue=TRUE;
while ((!feof ($fp))and $continue) {
$buffer = fgets($fp, 4096);
$continue=(strpos($buffer,'-')===FALSE); // the volumeID is the first that may contain a dash
}
// close
pclose($fp);
// extract information
$expl=explode(' ',$buffer);
$poubStr=$expl[count($expl)-1];
// display
echo "the Volume ID of $drive is $poubStr
";
} else echo "the command '$syscmd' could not be executed";
//end
?>

2) GetComputername in a BATch file
Program GetComputerName(InPut,OutPut);

{$APPTYPE CONSOLE}

Uses GetSystem;

Var trouve : String;

Begin
trouve:=GetSystem.GetComputerName;
WriteLn(trouve);
End. { GetComputerName Program }

PS I've a compiled version if you want, it's a small DOS executable of 59 KB

3) related unit giving away some interesting information :
unit GetSystem;

interface

(* TODO
FreeRes : cf X
console app identig
CPU usage ??? (perf API)
*)

Function GetHDDSerial(Drive : String) : String; // 'C:\', etc
procedure GetUserNameOrg(var username, organisation : String); // TODO
Function GetComputerName : String;
//VGR03102002 ADDed this
Function GetLogonName : String;

implementation

uses Windows, // pour type DWORD
SysUtils, // pour IntToHex()
Registry;

//How to get the serial number of HDD ? (numer seryjny dysku twardego)
Function GetHDDSerial(Drive : String) : String; // 'C:\', etc
Var VolumeSerialNumber : DWORD;
MaximumComponentLength : DWORD;
FileSystemFlags : DWORD;
SerialNumber : string;
begin
GetVolumeInformation(PChar(Drive), nil, 0, @VolumeSerialNumber, MaximumComponentLength,FileSystemFlags, nil, 0);
SerialNumber := IntToHex(HiWord(VolumeSerialNumber), 4) + '-' + IntToHex(LoWord(VolumeSerialNumber), 4);
GetHDDSerial:=SerialNumber;
end;

// How to get user name and registered organization?
Procedure GetUserNameOrg(var username, organisation : String);
var reg: TRegistry;
begin
(* TODO
reg := TRegistry.Create;
reg.RootKey:=HKEY_LOCAL_MACHINE;
If reg.OpenKey('SYSTEM',False)
then If reg.OpenKey('CurrentControlSet\Control\ComputerName\ComputerName',False)
Then GetComputerName:=reg.ReadString('ComputerName')
Else GetComputerName:='(non trouvé)'
Else GetComputerName:='(non trouvé)';
reg.Free;
*) username:='(non implémenté)'; organisation:='';
end;

// How to get user name and registered organization?
Function GetComputerName : String;
var reg: TRegistry;
begin
reg := TRegistry.Create;
reg.RootKey:=HKEY_LOCAL_MACHINE;
If reg.OpenKey('SYSTEM',False)
then If reg.OpenKey('CurrentControlSet\Control\ComputerName\ComputerName',False)
Then GetComputerName:=reg.ReadString('ComputerName')
Else GetComputerName:='(non trouvé)'
Else GetComputerName:='(non trouvé)';
reg.Free;
end;

Function GetLogonName;
var reg: TRegistry;
Begin
reg := TRegistry.Create;
reg.RootKey:=HKEY_CURRENT_USER;
If reg.OpenKey('Software',False)
then If reg.OpenKey('Microsoft\Windows\CurrentVersion\Explorer',False)
Then GetLogonName:=reg.ReadString('Logon User Name')
Else GetLogonName:='(non trouvé)'
Else GetLogonName:='(non trouvé)';
reg.Free;
End; // GetLogonName String Function

Begin { Init Part }
End.


4) this should be it

By: VGR Date: 13/05/2003 20:59:00 English  Type : Comment
5) getting IP@ (that's tricky depending on the OS version ! )

I've this interesting HTTP unit, where there 's a lot of C/C++ source commented out at the end (for reference or later porting depending on my needs :D )

The function I use to get my IP@sses (multiple NICs) is this :

poubBool:=IsNetConnected; // sets globIP the best possible way, and else 127.0.0.1
If NOT poubBool Then poubBool:=IsConnectedToInternet;

IsNetConnected is defined as this :

Function IsNetConnected : Boolean;
Var poubBool : Boolean;
HostName,
IPaddr,
WSAErr : String;
tabIPaddr : ttabIPaddr;
nbIPaddr : Byte;
Var resultat : Boolean;
i : Integer;
Begin
resultat:=False;
poubBool:=GetIPFromHost(HostName, IPaddr, WSAErr);
ChunkIp(IPaddr,tabIPaddr,nbIPaddr);
globIP:='127.0.0.1';
for i:=1 to nbIPaddr Do
//VGR28082002 MODification pour retourner la + grande @IP trouvie...
Begin
If (tabIPaddr>globIP) Then globIP:=tabIPaddr; // was : >'192.168.255.0'
End;
resultat:=(globIP>'192.168.255.0');
IsNetConnected:=resultat;
End;


---unit source
unit http;

// uniti pour tout ce qui est IP
//
//VGR26092002 : ADDed tout ce qui est WNet aussi (Windows Networking)
//

interface

uses stdctrls, // pour TMemo
SysUtils, // pour StrToInt()
Dialogs, // pour ShowMessage()
Psock, // pour les constantes de type Status_Basic
NMHttp; // pour TForm
I
Var globIP : String;

function GetIPFromHost(var HostName, IPaddr, WSAErr: string): Boolean;
//function GetLocalIPStrings : string;
Function GetLocalIP : String;
Function IsNetConnected : Boolean;
Function DoGet(parURL,ProxyName,ProxyPort : String ; boolProxy : Boolean ;
Var resHeader, resBody : TMemo; Var NMHTTP1 : TNMHTTP) : Boolean;
function IsConnectedToInternet: Boolean;

// WNet
Function GetWNetError(valeur : Cardinal) : String;
Procedure WNEnumereConnections(Var memo1 : TMemo);

implementation

Uses Windows, Winsock, // pour GetLocalIP
WinINet; // pour IsConnectedToInternet: Boolean;


function GetIPFromHost; // (var HostName, IPaddr, WSAErr: string): Boolean;
type
Name = array[0..100] of Char;
PName = ^Name;
TpInAddr = ^in_addr;
TppInAddr = ^TpInAddr;
var
HEnt: pHostEnt;
HName: PName;
WSAData: TWSAData;
// i: Integer;
lResult : Boolean;
poubInt : Integer;
liste : TppInAddr;
begin
lResult := False;
if WSAStartup($0101, WSAData) <> 0 then begin
WSAErr := 'Winsock is not responding."';
Exit;
end;
IPaddr := '';
New(HName);
if GetHostName(PChar(HName), SizeOf(Name)) = 0 then
begin
HostName := StrPas(PChar(HName));
HEnt := GetHostByName(PChar(HName));
liste:=pointer(HEnt^.h_addr_list);
if (liste<>Nil) Then // AND (liste^<>Nil) Then
Begin
IPaddr :=inet_ntoa(liste^^);
Inc(liste); // pointeur
While (liste^<>Nil) Do
Begin
IPaddr:=IPaddr+'|'+inet_ntoa(liste^^);
Inc(liste); // pointeur
End;
lResult := True;
End;
(*
for i := 0 to HEnt^.h_length - 1 do IPaddr :=Concat(IPaddr,IntToStr(Ord(HEnt^.h_addr_list^)) + '.');
SetLength(IPaddr, Length(IPaddr) - 1);
Result := True;
*)
end
else begin
case WSAGetLastError of
WSANOTINITIALISED:WSAErr:='WSANotInitialised';
WSAENETDOWN :WSAErr:='WSAENetDown';
WSAEINPROGRESS :WSAErr:='WSAEInProgress';
end;
end;
Dispose(HName);
poubInt:=WSACleanup;
GetIPFromHost:=lResult;
end;


Function GetLocalIP : String;
Var wVersionRequested : WORD;
wsaData : TWSAData;
p : PHostEnt;
s : array[0..128] Of Char;
p2 : PChar;
lresult : String;
poubInt : Integer;
Begin
lresult:='';
wVersionrequested:=MAKEWORD(1,1);
poubInt:=WSAStartup(wVersionRequested,wsaData);
try
poubInt:=GetHostName(PChar(s[0]),128);
p:=GetHostByName(PChar(s[0]));
lresult:=string(p^.h_addr_list^);
p2:=iNet_ntoa(PInAddr(p^.h_addr_list^)^);
lresult:=string(p2);
finally
poubInt:=WSACleanUp;
End;
GetLocalIP:=lresult;
End; // GetLocalIP String Function

Const cMacIPaddr = 5;
Type ttabIPaddr = array[1..cMacIPaddr] Of String;
Procedure ChunkIp(IPaddr : String; Var tabIPaddr : ttabIPaddr; Var nbIPaddr : Byte);
Var j : Word;
subch : String;
Begin
// parcours de la channe IPaddr ` la recherche des siparateurs d'adresses
j:=Pos('|',IPaddr);
nbIPaddr:=0;
While j>0 Do
Begin
subch:=Copy(IPaddr,1,j-1);
IPaddr:=Copy(IPaddr,j+1,Length(IPaddr)-j);
Inc(nbIPaddr);
tabIPaddr[nbIPaddr]:=subch;
j:=Pos('|',IPaddr);
End; // tant que suite
Inc(nbIPaddr);
tabIPaddr[nbIPaddr]:=IPaddr;
End; // ChunkIp Procedure

function IsConnectedToInternet: Boolean;
var dwConnectionTypes: DWORD;
begin
dwConnectionTypes := INTERNET_CONNECTION_MODEM + INTERNET_CONNECTION_LAN + INTERNET_CONNECTION_PROXY;
IsConnectedToInternet := InternetGetConnectedState(@dwConnectionTypes, 0);
end;

Function IsNetConnected : Boolean;
Var poubBool : Boolean;
HostName,
IPaddr,
WSAErr : String;
tabIPaddr : ttabIPaddr;
nbIPaddr : Byte;
Var resultat : Boolean;
i : Integer;
Begin
resultat:=False;
poubBool:=GetIPFromHost(HostName, IPaddr, WSAErr);
ChunkIp(IPaddr,tabIPaddr,nbIPaddr);
globIP:='127.0.0.1';
for i:=1 to nbIPaddr Do
//VGR28082002 MODification pour retourner la + grande @IP trouvie...
Begin
If (tabIPaddr>globIP) Then globIP:=tabIPaddr; // was : >'192.168.255.0'
End;
resultat:=(globIP>'192.168.255.0');
IsNetConnected:=resultat;
End;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
Function DoGet;//(parURL,ProxyName,ProxyPort : String ; boolProxy : Boolean ;
// Var resHeader, resBody : TMemo ; Var Form1 : TForm) : Boolean;
Var res : Boolean;
begin
//init
resBody.Text := '';
resHeader.Text := '';
//work
NMHTTP1.InputFileMode := FALSE;
NMHTTP1.OutputFileMode := FALSE;
NMHTTP1.ReportLevel := Status_Basic;
//VGR01082000 ADDed this :
//VGR15052001 MODified this :
NMHTTP1.TimeOut := 10000; // ms avant Exception (laquelle?)
//EoAdd
If boolProxy then
Begin
NMHTTP1.Proxy := ProxyName;
NMHTTP1.ProxyPort := StrToInt(ProxyPort);
End
Else // VR02082000 ADDed this security
Begin
NMHTTP1.Proxy := '';
NMHTTP1.ProxyPort := 80;
End;

//VGR01082000 ADDed the try..except block :
//VGR04082000 ADDed the test for okloop (Stop button)
try
NMHTTP1.Get(parURL);
resBody.Text := NMHTTP1.Body;
resHeader.Text := NMHTTP1.Header;
res:=Pos('404 Not',resHeader.Text)=0;
//VGR01082000 ADDed this :
//VGR29082002 MODification : disactivi
//If NMHTTP1.CookieIn <> '' then
// ShowMessage('Cookie:'+#13#10+NMHTTP1.CookieIn);
//EoAdd
except
On E:ESockError Do
Begin
ShowMessage('Exception caught : '+E.Message+#13#10+'(TimeOut)(incorrect proxy name?)');
res:=False;
End;
end;

DoGet:=res;
end; // DoGet Procedure

(*
Credits :
Jim Burns delphi@elists.org
Thu, 14 Mar 2002 15:23:37 -0600

{---------------------------------------------------------------------------
--------------------------------------------------------------------------
Name: WinAPI_GetHostName
Description: Returns the standard host name for the local machine

Dependency: The application is responsible for insuring a
call to WSAStartup has been made prior to calling this function!
}
function WinAPI_GetHostName : string;
begin
SetLength(Result, MAX_PATH);
if (gethostname(pchar(Result), MAX_PATH) = SOCKET_ERROR) then Result :=
GetLastWSAErrorString
else Result := pchar(Result);
end;

{---------------------------------------------------------------------------
--------------------------------------------------------------------------
Name: GetLocalIPString
Description: Returns a string, in dotted decimal format, representing the
local machine ip.

Dependency: The application is responsible for insuring a
call to WSAStartup has been made prior to calling this function!
}
function GetLocalIPString : string;
var
pHE : PHostEnt;
in_a : TInAddr;
begin
pHE := gethostbyname(pchar(WinAPI_GetHostName));
// Get local host name

if (pHE = nil) then in_a.S_addr := htonl(IP_LoopBack)
// 127.0.0.1
else in_a.S_addr := u_long(pointer(pHE^.h_addr_list^)^);

Result := inet_ntoa(in_a);
end;

{---------------------------------------------------------------------------
--------------------------------------------------------------------------
Name: GetLocalIPStrings
Description: Returns a comma delimited string containing all the system's
ips

Dependency: The application is responsible for insuring a
call to WSAStartup has been made prior to calling this function!
}
function GetLocalIPStrings : string;
var
pHE : PHostEnt;
ppin_a : TppInAddr;
begin
Result := NULLSTRING;

pHE := gethostbyname(pchar(WinAPI_GetHostName));
// Get hostent struct from local name
ppin_a := pointer(pHE^.h_addr_list);
// Set our ptr to the start of pHE's h_addr_list

if (ppin_a <> nil) AND (ppin_a^ <> nil) then begin
// Confirm ppin_a has a value & points to a value

Result := inet_ntoa(ppin_a^^);
// Get the first IP
Inc(ppin_a);
// Delphi's Inc() can advance ptr to next value
while (ppin_a^ <> nil) do begin
// While we still have entries in the list
Result := Result + COMMA + inet_ntoa(ppin_a^^);
// Add them to our Result
Inc(ppin_a);
// Inc() ptr to the next value
end;
//
end;
end;


//////
////// 10.0.0.0 - 10.255.255.255 (10/8 prefix) =
$0A000000 - $0AFFFFFF
////// 172.16.0.0 - 172.31.255.255 (172.16/12 prefix) =
$AC100000 - $AC1FFFFF
////// 192.168.0.0 - 192.168.255.255 (192.168/16 prefix) =
$C0A80000 - $C0A8FFFF
//////
const strings_PrivateIPPrefixes : array[0..2] of string = ('10.0.0.0/8',
'172.16.0.0/12', '192.168.0.0/16');

{---------------------------------------------------------------------------
--------------------------------------------------------------------------
Name: MakeSubnetMask
Description: x

}
function MakeSubnetMask(const bits : byte) : cardinal;
asm
mov EDX,$80000000
mov CL,AL
dec CL
sar EDX,CL
mov Result,EDX
end;

{---------------------------------------------------------------------------
--------------------------------------------------------------------------
Name: IsIPInPrivateSubnetRange
Description: Determines whether or not the passed in IP (string) is in the
range allotted for private IP addresses as provided for by the const
string array, strings_PrivateIPPrefixes.
}
function IsIPInPrivateSubnetRange(const IP : string) : boolean;
var
inIP, testIP, Mask : cardinal;
i : cardinal;
begin
inIP := IPStrToIP(IP);
Result := False;
for i := 0 to High(strings_PrivateIPPrefixes) do begin
testIP := IPStrToIP(SliceL(strings_PrivateIPPrefixes, FSLASH));
Mask := MakeSubnetMask(StrToInt(SliceR(strings_PrivateIPPrefixes,
FSLASH)));

if (testIP AND Mask) = (inIP AND Mask) then begin
Result := True;
exit;
end;
end;
end;

{---------------------------------------------------------------------------
--------------------------------------------------------------------------
Name: IPStrtoIP
Description: Converts an IP dotted decimal string to the 32-bit value

Winsock/Winsock2 --> unsigned long inet_addr(const char FAR
* cp);
function inet_addr(cp: pchar): u_long;
stdcall;
}
function IPStrToIP(const IPStr : string) : cardinal;
var
i : cardinal;
sR : string;
begin
Result := 0;
for i := 1 to 3 do begin
sR := GetElement(IPStr, DOT, i);
Result := Result + cardinal(StrToInt(sR));
Result := Result shl 8;
end;
sR := GetElement(IPStr, DOT, 4);
Result := Result + cardinal(StrToInt(sR));

end;

{---------------------------------------------------------------------------
--------------------------------------------------------------------------
Name: IPtoIPStr
Description: Converts an 32-bit IP value to dotted decimal string
representation

Winsock/Winsock2 --> char FAR* inet_ntoa (struct in_addr
in);
function inet_ntoa(inaddr: TInAddr):
pchar; stdcall;

How j moves backwards through Result
position (1-15) --> 0 123456789012345 6
w/dots --> 0 123.567.901.345 6
j
j
j
j
j
}
function IPToIPStr(IP : cardinal) : string;
const MAX_LENGTH = 15;
var
i, j, k : cardinal;
begin
SetZeroStr(Result, MAX_LENGTH);
// SetLength and Zero our Result string
j := MAX_LENGTH + 1;
// Start j at 1 pos past length of Result string
k := IP AND $FF;
// Get first lower byte
repeat
//
if (k < 10) then i := 1
// i = number of digits in k. Short for singles
else i := Trunc(Log10(k)) + 1;
// calculate for anything larger
Dec(j, i+1);
// Position j based on digits needed (i.e. in k)
MoveStr(IntToStr(k), 1, Result, j+1, i);
// Move the converted value into Result
Result[j] := DOT;
// Add the DOT
IP := IP shr 8;
// Shift IP down (right) to get the next byte
k := IP AND $FF;
// Set k to the next byte of IP
until (IP = 0);
//
Result[j] := NULL;
//
Result := copy(Result, j + 1, MAX_LENGTH - j);
//
end;
*)

Function GetWNetError; // (valeur : Cardinal) : String;
Var msg : String;
Begin
Case valeur Of
{ connection : }
WN_NOT_CONNECTED : msg:='non connecti';//= ERROR_NOT_CONNECTED;
WN_OPEN_FILES : msg:='erreur : des fichiers sont ouverts';//= ERROR_OPEN_FILES;
WN_DEVICE_IN_USE : msg:='device en cours d''utilisation';//= ERROR_DEVICE_IN_USE;
WN_BAD_NETNAME : msg:='mauvais nom de riseau';//= ERROR_BAD_NET_NAME;
WN_BAD_LOCALNAME : msg:='mauvais nom local';//= ERROR_BAD_DEVICE;
WN_ALREADY_CONNECTED : msg:='dij` connecti';//= ERROR_ALREADY_ASSIGNED;
WN_DEVICE_ERROR : msg:='erreur ginirale du device';//= ERROR_GEN_FAILURE;
WN_CONNECTION_CLOSED : msg:='diconnecti';//= ERROR_CONNECTION_UNAVAIL;
WN_NO_NET_OR_BAD_PATH : msg:='pas de riseau ou mauvais chemin d''acchs';//= ERROR_NO_NET_OR_BAD_PATH;
WN_BAD_PROVIDER : msg:='mauvais fournisseur (provider)';//= ERROR_BAD_PROVIDER;
WN_CANNOT_OPEN_PROFILE : msg:='impossible d''ouvrir le profil';//= ERROR_CANNOT_OPEN_PROFILE;
WN_BAD_PROFILE : msg:='mauvais profil';//= ERROR_BAD_PROFILE;
WN_BAD_DEV_TYPE : msg:='mauvais type de device';//= ERROR_BAD_DEV_TYPE;
WN_DEVICE_ALREADY_REMEMBERED : msg:='dij` mimorisi (remembered)';//= ERROR_DEVICE_ALREADY_REMEMBERED;
{ giniral : }
WN_SUCCESS : msg:='succhs';//= NO_ERROR; = WN_NO_ERROR : msg:='non connecti';//= NO_ERROR;
WN_NOT_SUPPORTED : msg:='non supporti';//= ERROR_NOT_SUPPORTED;
WN_CANCEL : msg:='annuli (cancelled)';//= ERROR_CANCELLED;
WN_RETRY : msg:='ri-essai';//= ERROR_RETRY;
WN_MORE_DATA : msg:='encore des donnies';//= ERROR_MORE_DATA;
WN_BAD_POINTER : msg:='mauvais pointeur d''adresse';//= ERROR_INVALID_ADDRESS;
WN_BAD_VALUE : msg:='mauvaise valeur de paramhtre';//= ERROR_INVALID_PARAMETER;
WN_BAD_USER : msg:='mauvais utilisateur (username)';//= ERROR_BAD_USERNAME;
WN_BAD_PASSWORD : msg:='mot de passe invalide';//= ERROR_INVALID_PASSWORD;
WN_ACCESS_DENIED : msg:='acchs refusi (denied)';//= ERROR_ACCESS_DENIED;
WN_FUNCTION_BUSY : msg:='fonction occupie (busy)';//= ERROR_BUSY;
WN_WINDOWS_ERROR : msg:='erreur Windows inattendue';//= ERROR_UNEXP_NET_ERR; = WN_NET_ERROR : msg:='non connecti';//= ERROR_UNEXP_NET_ERR;
WN_OUT_OF_MEMORY : msg:='pas assez de mimoire';//= ERROR_NOT_ENOUGH_MEMORY;
WN_NO_NETWORK : msg:='pas de riseau';//= ERROR_NO_NETWORK;
WN_EXTENDED_ERROR : msg:='erreur itendue';//= ERROR_EXTENDED_ERROR;
WN_BAD_LEVEL : msg:='mauvais niveau (level)';//= ERROR_INVALID_LEVEL;
WN_BAD_HANDLE : msg:='mauvaise rifirence (handle)';//= ERROR_INVALID_HANDLE;
WN_NOT_INITIALIZING : msg:='dij` initialisi';//= ERROR_ALREADY_INITIALIZED;
WN_NO_MORE_DEVICES : msg:='plus de devices';//= ERROR_NO_MORE_DEVICES;
{ inumiration : }
WN_NO_MORE_ENTRIES : msg:='plus d''items';//= ERROR_NO_MORE_ITEMS;
WN_NOT_CONTAINER : msg:='pas un conteneur';//= ERROR_NOT_CONTAINER;
{ Authentication }
WN_NOT_AUTHENTICATED : msg:='non authentifii';//= ERROR_NOT_AUTHENTICATED;
WN_NOT_LOGGED_ON : msg:='mauvais logon';//= ERROR_NOT_LOGGED_ON;
WN_NOT_VALIDATED : msg:='logon non validi';//= ERROR_NO_LOGON_SERVERS;
End; // Case
GetWNetError:=msg;
End; // GetWNetError String Function

Procedure WNEnumereConnections; // (Var memo1 : TMemo);
var NR : array [0..30] of TNetResource;
EnumHandle : DWORD;
Res : Cardinal;
Count, Size : DWORD;
I : Integer;
Buff : array [0..255] of Char;
S : string;
Begin
Memo1.Lines.Clear;
{ First enumerate the active conncections. }
Res := WNetOpenEnum(RESOURCE_CONNECTED,RESOURCETYPE_DISK, 0, nil, EnumHandle);
if (Res <> 0) then begin
ShowMessage('Error OpenEnum pour les connections actives = '+GetWNetError(Res));
Exit;
end;
Count := $FFFFFFFF;
Size := SizeOf(TNetResource) * 30;
Res := WNetEnumResource(EnumHandle, Count, @NR, Size);
if (Res <> 0) then begin
if Res <> ERROR_NO_MORE_ITEMS then
begin
ShowMessage('Error EnumResource des disques montis = '+GetWNetError(Res));
Exit;
end; // on accepte cette "erreur" qui n'en est pas une
end;
{ Iterate through the connections, and }
{ display the connection name in the memo. }
If Count>0 Then
for I := 0 to Count-1 do Memo1.Lines.Add(NR.lpRemoteName);
// sinon R`F
{ Close the enumeration. }
WNetCloseEnum(EnumHandle);
End; // WNEnumereConnections Procedure

end.



By: Okey Date: 13/05/2003 21:33:00 English  Type : Comment
Whoha what hammer!
__
~ ~ ~ @8-D

By: VGR Date: 13/05/2003 21:39:00 English  Type : Comment
merdusoft's "platform" is a big nail ;-)

Do register to be able to answer

EContact
browser fav
page generated in 352.799890 milliseconds

Why Google AdSense ads ?

compteur
 Ranking-Hits PageRank for this page