emo | Blog for programming languages

Delphi, calculate directory size

emo24.12.201426.12.2014

Code for fast calculating directori size in Delphi.

function TForm1.calclDirSize(dir: string): LongInt;
var
  totalSize: LongInt;

  procedure Find(Str: string);
  var
    MySearch: TSearchRec;
    FindResult: integer;
  begin
    FindResult := FindFirst(Str + '\*.*', faArchive + faHidden + faAnyFile +
      faVolumeID + faSysFile + faDirectory, MySearch);
    while FindResult = 0 do
    begin
      if (MySearch.Attr = faDirectory) and (MySearch.Name <> '.') and
        (MySearch.Name <> '..') then
        Find(Str + '\' + MySearch.Name)
      else
        totalSize := totalSize + MySearch.Size;
      FindResult := SysUtils.findNext(MySearch);
    end;
    FindClose(MySearch);
  end;

begin
  totalSize := 0;
  Find(dir);
  result := totalSize; // return size in bytes... divide 1024 for KB
end;

function TForm1.calclDirSize(dir: string): LongInt;

var

totalSize: LongInt;

procedure Find(Str: string);

var

MySearch: TSearchRec;

FindResult: integer;

begin

FindResult := FindFirst(Str + '\*.*', faArchive + faHidden + faAnyFile +

faVolumeID + faSysFile + faDirectory, MySearch);

while FindResult = 0 do

begin

if (MySearch.Attr = faDirectory) and (MySearch.Name <> '.') and

(MySearch.Name <> '..') then

Find(Str + '\' + MySearch.Name)

else

totalSize := totalSize + MySearch.Size;

FindResult := SysUtils.findNext(MySearch);

end;

FindClose(MySearch);

end;

begin

totalSize := 0;

Find(dir);

result := totalSize; // return size in bytes... divide 1024 for KB

end;

Delphi check for valid email

emo24.12.201426.12.2014

This procedure checks whether a valid e-mail

function TForm1.IsValidEmail(const Value: string): Boolean;

  function CheckAllowed(const s: string): Boolean;
  var i: Integer;
  begin
    Result:= false;
    {$IFDEF ANDROID}
    for i:= 0 to Length(s)-1 do
    {$ENDIF}
    {$IFDEF WIN32}
    for i:= 1 to Length(s) do
    {$ENDIF}
     begin
      if not (s[i] in ['a'..'z',
                       'A'..'Z',
                       '0'..'9',
                       '_',
                       '-',
                       '.'])
                       then
                          Exit;
     end;
    Result:= true;
  end;

var
  i: Integer;
  NamePart, ServerPart: string;
begin
  Result:= False;
  i:=Pos('@', Value);
  if i=0 then Exit;
  NamePart:=Copy(Value, 1, i-1);
  ServerPart:=Copy(Value, i+1, Length(Value));
  if (Length(NamePart)=0) or ((Length(ServerPart)<3)) then Exit;
  i:=Pos('.', ServerPart);
  if (i=0) or (i>(Length(serverPart)-2)) then Exit;
  Result:= CheckAllowed(NamePart) and CheckAllowed(ServerPart);
end;

function TForm1.IsValidEmail(const Value: string): Boolean;

function CheckAllowed(const s: string): Boolean;

var i: Integer;

begin

Result:= false;

{$IFDEF ANDROID}

for i:= 0 to Length(s)-1 do

{$ENDIF}

{$IFDEF WIN32}

for i:= 1 to Length(s) do

{$ENDIF}

begin

if not (s[i] in ['a'..'z',

'A'..'Z',

'0'..'9',

'_',

'-',

'.'])

then

Exit;

end;

Result:= true;

end;

var

i: Integer;

NamePart, ServerPart: string;

begin

Result:= False;

i:=Pos('@', Value);

if i=0 then Exit;

NamePart:=Copy(Value, 1, i-1);

ServerPart:=Copy(Value, i+1, Length(Value));

if (Length(NamePart)=0) or ((Length(ServerPart)<3)) then Exit;

i:=Pos('.', ServerPart);

if (i=0) or (i>(Length(serverPart)-2)) then Exit;

Result:= CheckAllowed(NamePart) and CheckAllowed(ServerPart);

end;

Delphi, how to download file from http link

emo24.12.201426.12.2014

This sample code show how in delhi downloadfile from WEB and handle it.

function TForm1.GetInetFile(const fileURL, filename: String): Boolean;
const
   BufferSize = 1024;
 var
   hSession, hURL: HInternet;
   Buffer: array[1..BufferSize] of Byte;
   BufferLen: DWORD;
   f: File;
   sAppName: string;
   tot:Longint;
 begin
  tot:=0;
  BufferLen:=0;
  result := false;
  sAppName := ExtractFileName(Application.ExeName) ;
  hSession := InternetOpen(PChar(sAppName), INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0) ;
  try
   hURL := InternetOpenURL(hSession, PChar(fileURL), nil, 0, INTERNET_FLAG_NO_CACHE_WRITE, 0) ;
   try
    AssignFile(f, FileName) ;
    Rewrite(f,1) ;
    repeat
     InternetReadFile(hURL, @Buffer, SizeOf(Buffer), BufferLen) ;
     BlockWrite(f, Buffer, BufferLen);
     tot:=tot+BufferLen;
    until BufferLen = 0;
    CloseFile(f) ;
    result := True;
   except
    InternetCloseHandle(hURL);
   end
  except
   InternetCloseHandle(hSession);
  end;
end;

function TForm1.GetInetFile(const fileURL, filename: String): Boolean;

const

BufferSize = 1024;

var

hSession, hURL: HInternet;

Buffer: array[1..BufferSize] of Byte;

BufferLen: DWORD;

f: File;

sAppName: string;

tot:Longint;

begin

tot:=0;

BufferLen:=0;

result := false;

sAppName := ExtractFileName(Application.ExeName) ;

hSession := InternetOpen(PChar(sAppName), INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0) ;

try

hURL := InternetOpenURL(hSession, PChar(fileURL), nil, 0, INTERNET_FLAG_NO_CACHE_WRITE, 0) ;

try

AssignFile(f, FileName) ;

Rewrite(f,1) ;

repeat

InternetReadFile(hURL, @Buffer, SizeOf(Buffer), BufferLen) ;

BlockWrite(f, Buffer, BufferLen);

tot:=tot+BufferLen;

until BufferLen = 0;

CloseFile(f) ;

result := True;

except

InternetCloseHandle(hURL);

end

except

InternetCloseHandle(hSession);

end;

Delphi how to get file version from code

emo24.12.201426.12.2014

This code get file version feom given file name tested with vesion 2007 … XE5

<pre class="lang:default decode:true " >function TForm1.GetFileInfo(filename: string): string;
type
  TLANGANDCODEPAGE = record
    wLanguage, wCodePage: Word;
  end;

  PLANGANDCODEPAGE = ^TLANGANDCODEPAGE;
var
  InfoResSize, // size of the version info resource
  Zero: dword; // tjis is junk variable, ignored
  VersionInfo, // pointer to  version info resource
  Info: pointer; //pointer to the version information
  Translation: PLANGANDCODEPAGE; // translation table
  VersionInfoSize: UINT; // size of version information
  InfoPath: string; // version info request string
begin
  // get the size of the version information , if exists
  // InfoResSize := 0;
  result := '';
  InfoResSize := GetFileVersionInfoSize(pchar(filename), Zero);

  if InfoResSize = 0 then
  begin
    exit;
  end;
  
  // Get  memory for the info structure
  GetMem(VersionInfo, InfoResSize);

  try
    // Get information of the current file
    if not GetFileVersionInfo(pchar(filename), 0, InfoResSize, VersionInfo) then
    begin
      FreeMem(VersionInfo);
      exit;
    end;

    if VerQueryValue(VersionInfo, '\VarFileInfo\Translation',
      pointer(Translation), VersionInfoSize) then
    begin
      // set the version value path string
      InfoPath := '\StringFileInfo\' + IntToHex(Translation^.wLanguage, 4) +
        IntToHex(Translation^.wCodePage, 4) + '\';

      GetMem(Info, 2000);
      VerLanguageName(Translation^.wLanguage, Info, 2000);
      FreeMem(Info);
    end
    else // set default value
    begin
      // set the version value path string
      InfoPath := '\StringFileInfo\040904E4\';
    end;

    // File Version
    if VerQueryValue(VersionInfo, pchar(InfoPath + 'FileVersion'), Info,
      VersionInfoSize) then
    begin
      result := string(pchar(Info));
    end;

  finally
    // free the memory
    FreeMem(VersionInfo, InfoResSize);
  end;

end;</pre>

<pre class="lang:default decode:true " >function TForm1.GetFileInfo(filename: string): string;

type

TLANGANDCODEPAGE = record

wLanguage, wCodePage: Word;

end;

PLANGANDCODEPAGE = ^TLANGANDCODEPAGE;

var

InfoResSize, // size of the version info resource

Zero: dword; // tjis is junk variable, ignored

VersionInfo, // pointer to version info resource

Info: pointer; //pointer to the version information

Translation: PLANGANDCODEPAGE; // translation table

VersionInfoSize: UINT; // size of version information

InfoPath: string; // version info request string

begin

// get the size of the version information , if exists

// InfoResSize := 0;

result := '';

InfoResSize := GetFileVersionInfoSize(pchar(filename), Zero);

if InfoResSize = 0 then

begin

exit;

end;

// Get memory for the info structure

GetMem(VersionInfo, InfoResSize);

try

// Get information of the current file

if not GetFileVersionInfo(pchar(filename), 0, InfoResSize, VersionInfo) then

begin

FreeMem(VersionInfo);

exit;

end;

if VerQueryValue(VersionInfo, '\VarFileInfo\Translation',

pointer(Translation), VersionInfoSize) then

begin

// set the version value path string

InfoPath := '\StringFileInfo\' + IntToHex(Translation^.wLanguage, 4) +

IntToHex(Translation^.wCodePage, 4) + '\';

GetMem(Info, 2000);

VerLanguageName(Translation^.wLanguage, Info, 2000);

FreeMem(Info);

end

else // set default value

begin

// set the version value path string

InfoPath := '\StringFileInfo\040904E4\';

end;

// File Version

if VerQueryValue(VersionInfo, pchar(InfoPath + 'FileVersion'), Info,

VersionInfoSize) then

begin

result := string(pchar(Info));

end;

finally

// free the memory

FreeMem(VersionInfo, InfoResSize);

end;

end;</pre>

How to open unknow image format from BLOB stream in Delphi

emo24.12.201426.12.2014

If you have databse Blob file containing image but you don’t know how to open this , here is code :

procedure TForm1.getPicture(image:TImage; DataSource1: TDataSource;Field:string);
var
  memStream: TMemoryStream;
  FirstBytes: AnsiString;
  Graphic: Graphics.TGraphic;
  bm:Graphics.Tbitmap;
begin
 memStream := TMemoryStream.Create;
 (DataSource1.Dataset.FieldbyName(Field) as TBlobfield).SaveToStream(memStream);
 memStream.Seek(0, 0);
 SetLength(FirstBytes, 8);
 memstream.Read(FirstBytes[1], 8);
 bm:=Graphics.TBitmap.Create;
  if Copy(FirstBytes, 1, 2) = 'BM' then
    begin
      Graphic := Graphics.TBitmap.Create;
    end else
    if FirstBytes = #137'PNG'#13#10#26#10 then
    begin
      Graphic := TPNGGraphic.Create;
    end else
    if Copy(FirstBytes, 1, 3) =  'GIF' then
    begin
      Graphic := TGIFImage.Create;
    end else
    if Copy(FirstBytes, 1, 2) = #$FF#$D8 then
    begin
      Graphic := TJPEGImage.Create;
    end;

    if Assigned(Graphic) then
    begin
      try
        memstream.Seek(0, soFromBeginning);
        Graphic.LoadFromStream(memstream);
        BM.Assign(Graphic);
        Image.Visible:=true;
        image.Picture.Assign(bm);
        //image2.Canvas.Draw(0,0,bm);
      except
      end;
      Graphic.Free;
    end;
   memStream.Free;
   bm.Free;
end;

procedure TForm1.getPicture(image:TImage; DataSource1: TDataSource;Field:string);

var

memStream: TMemoryStream;

FirstBytes: AnsiString;

Graphic: Graphics.TGraphic;

bm:Graphics.Tbitmap;

begin

memStream := TMemoryStream.Create;

(DataSource1.Dataset.FieldbyName(Field) as TBlobfield).SaveToStream(memStream);

memStream.Seek(0, 0);

SetLength(FirstBytes, 8);

memstream.Read(FirstBytes[1], 8);

bm:=Graphics.TBitmap.Create;

if Copy(FirstBytes, 1, 2) = 'BM' then

begin

Graphic := Graphics.TBitmap.Create;

end else

if FirstBytes = #137'PNG'#13#10#26#10 then

begin

Graphic := TPNGGraphic.Create;

end else

if Copy(FirstBytes, 1, 3) = 'GIF' then

begin

Graphic := TGIFImage.Create;

end else

if Copy(FirstBytes, 1, 2) = #$FF#$D8 then

begin

Graphic := TJPEGImage.Create;

end;

if Assigned(Graphic) then

begin

try

memstream.Seek(0, soFromBeginning);

Graphic.LoadFromStream(memstream);

BM.Assign(Graphic);

Image.Visible:=true;

image.Picture.Assign(bm);

//image2.Canvas.Draw(0,0,bm);

except

end;

Graphic.Free;

end;

memStream.Free;

bm.Free;

end;

This tested with delphi 2007..XE5

Delphi heaven…

emo24.10.201424.10.2014

If you delphi programmer , if you like to view useful code sniplets this place for you!

Blog for programming languages

tip and tricks for Java, Android, Delphi, PHP and JavaScript

Author: emo

Delphi, calculate directory size

Delphi check for valid email

Delphi, how to download file from http link

Delphi how to get file version from code

How to open unknow image format from BLOB stream in Delphi

Delphi heaven…