library Utils;

{ Remarque importante concernant la gestion de mémoire de DLL : ShareMem doit
  être la première unité de la clause USES de votre bibliothèque ET de votre projet
  (sélectionnez Projet-Voir source) si votre DLL exporte des procédures ou des
  fonctions qui passent des chaînes en tant que paramètres ou résultats de fonction.
  Cela s'applique à toutes les chaînes passées de et vers votre DLL --même celles
  qui sont imbriquées dans des enregistrements et classes. ShareMem est l'unité
  d'interface pour le gestionnaire de mémoire partagée BORLNDMM.DLL, qui doit
  être déployé avec vos DLL. Pour éviter d'utiliser BORLNDMM.DLL, passez les
  informations de chaînes avec des paramètres PChar ou ShortString. }

uses
  SysUtils,
  ShellApi,
  FileCtrl,
  windows;

Function GetUserFromWindows(strName:pString;NameLen:integer):integer;stdcall;
var
  str:string;
  buffer:array[0..255] of char;
  size:dword;
begin
   size:=256;
   If GetUserName(buffer, size) Then
     str := Copy(buffer,1,254)
   Else
     str := 'Unknown';
   if length(str) < NameLen then NameLen:=length(str);
   CopyMemory(pbyte(pstring(strName)^),pbyte(str),NameLen);
   result:=1;
end;

Function GetShortName(sLongName:pString;cLength:integer):integer;stdcall;
var
   sShortName    : string;
 begin
   sShortName := ExtractShortPathName(sLongName^);
   while (length(sShortName)<cLength) do sShortName := sShortName+' ';
   CopyMemory(pbyte(sLongName^),pbyte(sShortName),cLength);
   result:= 1;
 end;

Function GetDirectory(PanoStr,PanoTitle:pstring;PanoLen:integer):integer;stdcall;
var
 chemin:string;
begin
  result := 1;
  if not SelectDirectory(PanoTitle^, '',chemin) then result := 0
  else begin
    while (length(chemin)<PanoLen) do chemin := chemin+' ';
    CopyMemory(pbyte(PanoStr^),pbyte(chemin),PanoLen)
  end
end;


Function Execute(PanoStr:pstring):integer;stdcall;
begin
  ShellExecute(0,nil,Pchar(PanoStr^),nil,Nil,0);
  result := 1;
end;

Function ExecuteAndWait(PanoStr:pstring):integer;stdcall;
var
  StartInfo:TStartupInfo;
  ProcInfo:TProcessInformation;
  CreateOk:Boolean;
begin
  Fillchar(StartInfo,Sizeof(TStartupInfo),#0);
  Fillchar(ProcInfo,Sizeof(TProcessInformation),#0);
  StartInfo.cb := SizeOf(TStartupInfo);
  StartInfo.dwFlags := STARTF_USESHOWWINDOW;
  StartInfo.wShowWindow := SW_HIDE;
  CreateOK := CreateProcess(nil, PChar(PanoStr^), nil, nil,False,
              CREATE_NEW_PROCESS_GROUP+NORMAL_PRIORITY_CLASS,
              nil, nil, StartInfo, ProcInfo);
  if CreateOK then begin
    WaitForSingleObject(ProcInfo.hProcess, INFINITE);
    result := 1;
  end
  else result := 0;
end;


exports
 GetUserFromWindows,
 ExecuteAndWait,
 Execute,
 GetDirectory,
 GetShortName;

begin
end.