Collection of Delphi useful functions and procedures

Delphi function for wait until an external process has completed

function ShellExecute_AndWait(const FileName: string; const Params: string): bool;

var

  exInfo: TShellExecuteInfo;

  Ph: DWORD;

begin


  FillChar(exInfo, SizeOf(exInfo), 0);

  with exInfo do

  begin

    cbSize := SizeOf(exInfo);

    fMask := SEE_MASK_NOCLOSEPROCESS or SEE_MASK_FLAG_DDEWAIT;

    Wnd := GetActiveWindow();

    exInfo.lpVerb := 'open';

    exInfo.lpParameters := PChar(Params);

    lpFile := PChar(FileName);

    nShow := SW_HIDE;

  end;

  if ShellExecuteEx(@exInfo) then

    Ph := exInfo.hProcess

  else

  begin

    ShowMessage(SysErrorMessage(GetLastError));

    Result := true;

    exit;

  end;

  while WaitForSingleObject(exInfo.hProcess, 50) <> WAIT_OBJECT_0 do

    Application.ProcessMessages;

  CloseHandle(Ph);


  Result := true;

end;

Download file with Delphi

uses
  Forms, URLMon, Wininet, IdHTTP, IdComponent;
 

 type
  TEventHandler = class
    procedure HttpWork(ASender: TObject; AWorkMode: TWorkMode; AWorkCount: Integer);
  end;

 

var
  ProgressBar1: TProgressBar;
  Form1: TForm;
 

procedure TEventHandler.HttpWork(ASender: TObject; AWorkMode: TWorkMode; AWorkCount: Integer);
var
  Http: TIdHTTP;
  ContentLength: Int64;
  Percent: Integer;
  origin : cardinal;
begin
  Http := TIdHTTP(ASender);
  if not InternetGetConnectedState(@origin,0) then
  begin
    Application.MessageBox('Connection lost!','Warning',MB_OK+MB_ICONWARNING);
    Abort;
  end;
  ContentLength := Http.Response.ContentLength;
  if (Pos('chunked', LowerCase(Http.Response.ResponseText)) = 0) and
     (ContentLength > 0) then
  begin
    Percent := 100*AWorkCount div ContentLength;
    ProgressBar1.Position := Round(Percent);
    Form1.Refresh;
  end
  else
  begin
    Percent := 99;
    ProgressBar1.Position := Round(Percent);
    Form1.Refresh;
  end;
end;

function DownloadFile(SourceFile, DestFile: string): Boolean;
const
  RECV_BUFFER_SIZE = 32768;
var
  HttpClient: TIdHttp;
  FileSize: Int64;
  Buffer: TMemoryStream;
  handler: TEventHandler;
  origin : cardinal;
begin
  HttpClient := TIdHttp.Create(nil);
  try
    if not InternetGetConnectedState(@origin,0) then
    begin
      Application.MessageBox('No internet connection available!','Warning',MB_OK+MB_ICONWARNING);
      Abort;
    end;

    try
      HttpClient.Head(SourceFile);
    except
      Application.MessageBox('No internet connection available!','Warning',MB_OK+MB_ICONWARNING);
      Abort;
    end;
   
    FileSize := HttpClient.Response.ContentLength;

    Buffer := TMemoryStream.Create;
    try
      Form1 := TForm.Create(nil);
      Form1.Width := 400;
      Form1.Height := 200;
      Form1.Caption := 'Download file';
      Form1.Position := poDesktopCenter;
      ProgressBar1 := TProgressBar.Create(Form1);
      ProgressBar1.Parent := Form1;
      ProgressBar1.Width := 300;
      ProgressBar1.Height := 40;
      ProgressBar1.Left := 20;
      ProgressBar1.Top := 50;
      ProgressBar1.Max := 100;

      Form1.Show;

      while Buffer.Size < FileSize do
      begin
        HttpClient.Request.ContentRangeStart := Buffer.Size;
        if Buffer.Size + RECV_BUFFER_SIZE < FileSize then
          HttpClient.Request.ContentRangeEnd := Buffer.Size + RECV_BUFFER_SIZE - 1
        else
          HttpClient.Request.ContentRangeEnd := FileSize;

        handler := TEventHandler.Create;
        HttpClient.OnWork:= handler.HttpWork;

        HttpClient.Get(HttpClient.URL.URI, Buffer); // wait until it is done
        Buffer.SaveToFile(DestFile);

        ProgressBar1.Position := 99;
        ProgressBar1.Refresh;
        Form1.Refresh;
        Sleep(2000);
      end;
    finally
      Buffer.Free;
      ProgressBar1.Free;
      Form1.Free;
    end;
  finally
    HttpClient.Free;
  end;
end;

Delphi function to check a string if it's number

function IsNumber(Text: String): Boolean;

var i: Integer;

   
c: char;

begin

 
Result := True;

 
if Length(Text) <= 0 then

   
Result := False;

 
for i := 1 to Length(Text) do

 
begin

   
c := Text[i];

   
if not ((c >= '0') and (c <= '9')) then

   
if not ((c = DecimalSeparator) and (i > 1)) then

   
if not ((c = '-') and (i = 1)) then

   
if not ((c = '+') and (i = 1)) then

   
begin

      Result
:= False;

      //Break;

    end;

 
end;

end;

Extract integer part of a string - Delphi function

function ExtractIntegerPartOfString(const AValue: String; var StrPart: String; var IntPart: Integer): String;

var

 
I: Integer;

begin

 
Result := '0';

 
StrPart := '';

 
IntPart := 1;

 
for I := length(AValue)-1 downto 0 do

 
begin

   
if not (Ord(AValue[I]) in [Ord('0')..Ord('9')]) then

   
begin

      if Length(AValue)-I > 0 then

      begin

        StrPart := LeftStr(AValue,I);

try

          IntPart := StrToInt(RightStr(AValue,Length(AValue)-I))+1;

        except

          IntPart := 1;

          StrPart := LeftStr(AValue,I+1);

        end;

Result := FormatFloat(Copy('000000000000',1,Length(AValue)-I),IntPart);

      end;

      Break;

   
end;

 
end;

end;

Delphi function for sending an email using MAPI

uses

 
MAPI;

function SendMailMAPI(const Subject, Body, FileName, SenderName, SenderEMail,

                  RecepientName, RecepientEMail: String) : Integer;

var

 
message: TMapiMessage;

 
lpSender,

 
lpRecepient: TMapiRecipDesc;

 
FileAttach: TMapiFileDesc;

 
SM: TFNMapiSendMail;

 
MAPIModule: HModule;

begin

 
FillChar(message, SizeOf(message), 0);

 
with message do

 
begin

   
if (Subject<>'') then

   
begin

      lpszSubject
:= PChar(Subject)

   
end;

   
if (Body<>'') then

   
begin

      lpszNoteText
:= PChar(Body)

   
end;

   
if (SenderEMail<>'') then

   
begin

      lpSender.ulRecipClass
:= MAPI_ORIG;

      if (SenderName='') then

      begin

        lpSender.lpszName := PChar(SenderEMail)

end

      else

      begin

        lpSender.lpszName := PChar(SenderName)

      end;

      lpSender.lpszAddress
:= PChar('SMTP:'+SenderEMail);

      lpSender.ulReserved
:= 0;

      lpSender.ulEIDSize
:= 0;

      lpSender.lpEntryID
:= nil;

      lpOriginator
:= @lpSender;

   
end;

   
if (RecepientEMail<>'') then

   
begin

      lpRecepient.ulRecipClass
:= MAPI_TO;

      if (RecepientName='') then

      begin

        lpRecepient.lpszName := PChar(RecepientEMail)

end

      else

      begin

        lpRecepient.lpszName := PChar(RecepientName)

      end;

      lpRecepient.lpszAddress
:= PChar('SMTP:'+RecepientEMail);

      lpRecepient.ulReserved
:= 0;

      lpRecepient.ulEIDSize
:= 0;

      lpRecepient.lpEntryID
:= nil;

      nRecipCount
:= 1;

      lpRecips
:= @lpRecepient;

end

   
else

   
begin

      lpRecips
:= nil

   
end;

   
if (FileName='') then

   
begin

      nFileCount
:= 0;

      lpFiles
:= nil;

end

   
else

   
begin

      FillChar(FileAttach, SizeOf(FileAttach), 0);

      FileAttach.nPosition
:= Cardinal($FFFFFFFF);

      FileAttach.lpszPathName
:= PChar(FileName);

      nFileCount
:= 1;

      lpFiles
:= @FileAttach;

   
end;

 
end;

 
MAPIModule := LoadLibrary(PChar(MAPIDLL));

 
if MAPIModule=0 then

 
begin

   
Result := -1

end

 
else

 
begin

try

      @SM := GetProcAddress(MAPIModule, 'MAPISendMail');

      if @SM<>nil then

      begin

        Result := SM(0, Application.Handle, message, MAPI_DIALOG
or

                     MAPI_LOGON_UI, 0);

end

      else

      begin

        Result := 1

      end;

   
finally

      FreeLibrary(MAPIModule);

   
end;

end

 
if Result<>0 then

 
begin

   
MessageDlg('Error
sending mail ('+IntToStr(Result)+').', mtError, [mbOk],

0)

 
end;

end;