Home > Tech Zone > Delphi

 

Below some Delphi functions and tips. Some of them have been found on the web and other were made by me.

Hope this helps !

 

1.

Types

1.1.

How to test if an input is a number ?

1.2.

Hexadecimal to decimal and binary conversions

 

 

2.

Files & Directories

2.1.

How to list the sub-directories of a directory (not recursive) ?

2.2.

How to list all the sub-directories and files of a directory (recursive) ?

2.3.

How to rename a directory ?

2.4.

How to test if a path is a file or a directory ?

2.5.

How to know the path of the executable ?

2.6.

How to detect if a file is in read only mode ?

 

 

3.

System

3.1.

How to find the default browser ?

3.2.

How to know the type of a drive ?

3.3.

How to find the temporary directory ?

 

 

4.

Miscellaneous

4.1.

How to insert a carriage return in a Messagedlg box ?

 

 

 

___________________________

 

  

1. Types

 

1.1. How to test if an input is a number ?

Function IsNumber(AValue:string):boolean;
begin
 try
  StrToInt(AValue);
  result := true;
 except
  result := false;
 end;
end;

Top

1.2. Hexadecimal to decimal and binary conversions

Function HexToInt(HexNum: string): LongInt;

begin

  Result:=StrToInt('$' + HexNum);

end;

 

Function HexToBin(Hexadecimal: string): string;

const

BCD: array [0..15] of string =

('0000', '0001', '0010', '0011', '0100', '0101', '0110', '0111',

'1000', '1001', '1010', '1011', '1100', '1101', '1110', '1111');

var

  i: integer;

begin

  for i := Length(Hexadecimal) downto 1 do

    Result := BCD[StrToInt('$' + Hexadecimal[i])] + Result;

end;

Top

 

2. Files & Directories

 

2.1. How to list the sub-directories of a directory (not recursive) ?

Procedure TForm1.MyListDir(PATH:String);

VAR TS:TSearchRec;

BEGIN

IF(FindFirst(PATH+'\*.*',faDirectory,TS)=0)THEN

 REPEAT

  IF(DirectoryExists(PATH+'\'+TS.Name))AND

  (TS.Name<>'.')AND(TS.Name<>'..')THEN

  BEGIN

  ListBox1.Items.Add(PATH+'\'+TS.Name);

  MyListDir(PATH+'\'+TS.Name);

  END;

 UNTIL(FindNext(TS)<>0);

FindClose(TS);

END;

Top

2.2. How to list all the sub-directories and files of a tree/directory (recursive) ?

Procedure TForm1.ListFilesAndSubDirs(PATH:String);

VAR

TS, Info:TSearchRec;

BEGIN

IF(FindFirst(PATH+'\*.*',fadirectory,TS)=0)THEN

 REPEAT

 IF (TS.Name<>'.')AND(TS.Name<>'..')THEN

 BEGIN

 { Directories in ListBox1 and Files in ListBox2 }

   If Not((TS.Attr And faDirectory)=0) Then

     Memo1.Lines.Add('DIRECTORY -> '+PATH+'\'+TS.Name)

   Else

     Memo1.Lines.Add('FILE -> '+PATH+'\'+TS.Name);

 ListDir(PATH+'\'+TS.Name);

 END;

UNTIL(FindNext(TS)<>0);

FindClose(TS);

END;

Top

2.3. How to rename a directory ?

Procedure TForm1.Button1Click(Sender: TObject);

var

  st1, st2: PChar;

begin

  st1:='c:\OldDirectory';

  st2:='c:\NewDirectory';

  MoveFile(st1, st2);

end;

Top

2.4. How to test if a path is a file or a directory ?

Function IsDirectory (myname : String): boolean;

begin

  if DirectoryExists(MyName) = true then

    Result := true

  else

    Result := false;

end;


Function IsFile (myname : String): boolean;

begin

  if FileExists(MyName) = true then

    Result := true

  else

    Result := false;

end;

Top

2.5. How to know the path of the executable ?

Procedure TForm1.Button1Click(Sender: TObject);

var

  MyDir : string;

begin

  MyDir:=ExtractFilePath(Application.ExeName);

  Showmessage(MyDir);

end;

Top

2.6. How to detect if a file is in read only mode ?

Procedure TForm1.Button1Click(Sender: TObject);

var

MyFile : string;

Attrs : integer;

begin

MyFile := 'c:\temp\myfile.txt';

Attrs := FileGetAttr(MyFile);

if (Attrs and faReadOnly) = 0 then

  showmessage(inttostr(Attrs)+' : Not a read only file !')

else

  showmessage(inttostr(Attrs)+' : Read only file !');

end;

Top

 

3. System

 

3.1. How to find the default browser ?

function GetDefBrowser: string;

var

  Reg: TRegistry;

  tempstr: string;

begin

  Result := '';

  Reg := TRegistry.Create;

  try

    Reg.RootKey := HKEY_CLASSES_ROOT;

    if Reg.OpenKey('\http\shell\open\command', FALSE) then

      if Reg.ValueExists('') then

        tempstr := Reg.ReadString('');

      tempstr := copy(tempstr, 0, length(tempstr) - length(extractfileext(tempstr))) + '.exe';

      if copy(tempstr, 1, 1) = '"' then

        tempstr := copy(tempstr, 2, length(tempstr) - 1);

      result := tempstr;

      Reg.CloseKey;

  finally

  Reg.Free;

  end;

end;

Top

3.2. How to know the type of a drive ?

Function DriveType(Drive: String): String;

begin

case GetDriveType(Pchar(Drive)) of

  DRIVE_REMOVABLE : Result := 'Lecteur de disquette';

  DRIVE_FIXED : Result := 'Lecteur de disque';

  DRIVE_REMOTE : Result := 'Lecteur distant';

  DRIVE_CDROM : Result := 'Lecteur de CD-ROM';

  DRIVE_RAMDISK : Result := 'RamDisk'

else

  Result := 'Inconnu';

end;

Top

3.3. How to find the temporary directory ?

Function GetTempDirectory: String;

var

DossierTemp: array[0..255] of Char;

begin

  result:='';

if GetTempPath(255, @DossierTemp)<>0 then

  Result := StrPas(DossierTemp);

end;

Top

 

4. Miscellaneous

 

4.1. How to insert a carriage return in a Messagedlg box ?

MessageDlg('1st line'+ sLineBreak + '2nd line', mtInformation, [mbOK], 0);

Top

 

 

 


Guilleminot.org - Copyright © 2002/2008
All Rights Reserved