Site Map Email Us Home
 
All Products
Clever Internet Suite
Clever Internet .NET Suite
Clever Internet ActiveX Suite
Clever Keyboard Indicator
Database Comparer
Database Comparer VCL
Database Comparer ActiveX
Interbase DataPump
Subscribe and receive email notifications on all major releases and other important events.
Your Name:
Your Email:
 

Best Offer for Delphi / C++ Builder Developers

 

Buy FIBPlus at discount price !

 
 
Products Articles Downloads Order Support
Components  | Samples  | FAQ  | Download  | Order  | History 
 

Code Samples

These Code Samples show how to use the Clever Internet Suite components in your application.

Check also: SSL / TLS supportUsing Certificates and FTP + SSL

Need more Help? Contact usDownload Trial version

Downloader

Check also Multipart Multithreaded Downloading

HTTP Client

HTTP Request

Check also Build Form Post Request

IMAP Client

Mail Message

Check also Build New Mail Message

POP3 Client

SMTP Client

Uploader

Web DAV

How to download a file to the local PC asynchonously

procedure TfmTestDownloader.btDownLoadClick(Sender: TObject);
begin
   if clDownloader1.IsBusy then Exit;

   clDownloader1.URL := 'http://www.clevercomponents.com/images/testimage.jpg';
   clDownloader1.LocalFolder := 'c:\downloads';
   clDownLoader1.Start();
end;

procedure TfmTestDownloader.clDownLoader1StatusChanged(Sender: TObject; Status: TclProcessStatus);
begin
   case Status of
      psSuccess: ShowMessage('Process completed successfully');
      psFailed: ShowMessage((Sender as TclDownLoader).Errors.Text);
      psTerminated: ShowMessage('Process stopped');
      psErrors: ShowMessage('Process completed with some warnings');
   end;
end;

How to download a file into the memory

procedure TfmTestDownloader.btDownLoadClick(Sender: TObject);
begin
   if clDownloader1.IsBusy then Exit;

   FMemory := TMemoryStream.Create();
   clDownloader1.DataStream := FMemory;
   clDownloader1.URL := 'http://www.clevercomponents.com/checknews/clnews.html';
   clDownLoader1.Start();
end;

procedure TfmTestDownloader.clDownLoader1ProcessCompleted(Sender: TObject);
begin
   clDownloader1.DataStream := nil;
   FMemory.SaveToFile('clnews.html');
   FMemory.Free();
end;

How to download a file to the local PC in a synchonous mode

procedure TfmTestDownloader.btDownLoadClick(Sender: TObject);
begin
   clDownloader1.URL := 'http://www.clevercomponents.com/images/testimage.jpg';
   clDownloader1.LocalFolder := 'c:\downloads';
   clDownLoader1.Start(False);
end;

Setting the proxy user and proxy password when connecting via HTTP proxy

procedure TfmTestDownloader.btDownLoadClick(Sender: TObject);
begin
   if clDownloader1.IsBusy then Exit;

   clDownloader1.HttpProxySettings.UserName := 'Test';
   clDownloader1.HttpProxySettings.Password := 'psw';

clDownloader1.URL := 'http://www.clevercomponents.com/checknews/clnews.html';
   clDownloader1.LocalFile := 'clnews.html';
   clDownloader1. HttpProxySettings.Server := 'http://www.freeproxy.com';
   clDownLoader1.Start();
end;

Storing and restoring the resource downloading state

procedure TfmTestDownloader.btDownLoadClick(Sender: TObject);
begin
   if clDownloader1.IsBusy then Exit;

   clDownloader1.URL := 'http://www.clevercomponents.com/images/testimage.jpg';
   clDownloader1.LocalFile := 'testimage.jpg';
   clDownLoader1.Start();
end;

procedure TfmTestDownloader.StoreResourceInfo;
var
   i: Integer;
   IniFile: TIniFile;
begin
   IniFile := TIniFile.Create('set.ini');
   try
      IniFile.WriteString('Download','URL', clDownLoader1.URL);
      IniFile.WriteString('Download','LocalFile', clDownLoader1.LocalFile);
      IniFile.WriteInteger('ResourceState', 'Count', clDownLoader1.ResourceState.Count);
      IniFile.WriteInteger('ResourceState', 'ResourceSize', clDownLoader1.ResourceState.ResourceSize);
      for i := 0 to clDownLoader1.ResourceState.Count - 1 do
      begin
         IniFile.WriteInteger('ResourceStateItem' + IntToStr(i), 'ResourcePos', clDownLoader1.ResourceState[i].ResourcePos);
         IniFile.WriteInteger('ResourceStateItem' + IntToStr(i), 'BytesToProceed', clDownLoader1.ResourceState[i].BytesToProceed);
         IniFile.WriteInteger('ResourceStateItem' + IntToStr(i), 'BytesProceed', clDownLoader1.ResourceState[i].BytesProceed);
      end;
   finally
      IniFile.Free();
   end;
end;

procedure TfmTestDownloader.RestoreResourceInfo;
var
   i, cnt: Integer;
   IniFile: TIniFile;
   Item: TclResourceStateItem;
begin
   clDownLoader1.ResourceState.Clear();
   if not FileExists('set.ini') then Exit;
   IniFile := TIniFile.Create('set.ini');
   try
      clDownloader1.URL:=IniFile.ReadString('Download', 'URL', '');
      clDownloader1.LocalFile:=IniFile.ReadString('Download', 'LocalFile', '');
      cnt := IniFile.ReadInteger('ResourceState', 'Count', 0);
      clDownLoader1.ResourceState.ResourceSize := IniFile.ReadInteger('ResourceState', 'ResourceSize', 0);
      for i := 0 to cnt - 1 do
      begin
         Item := clDownLoader1.ResourceState.Add();
         Item.ResourcePos := IniFile.ReadInteger('ResourceStateItem' + IntToStr(i), 'ResourcePos', 0);
         Item.BytesToProceed := IniFile.ReadInteger('ResourceStateItem' + IntToStr(i), 'BytesToProceed', 0);
         Item.BytesProceed := IniFile.ReadInteger('ResourceStateItem' + IntToStr(i), 'BytesProceed', 0);
      end;
   finally
      IniFile.Free();
   end;
end;

procedure TfmTestDownloader.FormClose(Sender: TObject; var Action: TCloseAction);
begin
   StoreResourceInfo();
end;

procedure TfmTestDownloader.FormCreate(Sender: TObject);
begin
   RestoreResourceInfo();
end;

Error Handling in synchronous mode

procedure TfmTestDownloader.btDownLoadClick(Sender: TObject);
begin
   clDownloader1.URL := 'http://www.clevercomponents.com/images/testimage.jpg';
   clDownloader1.LocalFolder := 'c:\downloads';
   clDownLoader1.Start(False);

   case clDownLoader1.ResourceState.LastStatus of
      psSuccess: ShowMessage('Process completed successfully');
      psFailed: ShowMessage((Sender as TclDownLoader).Errors.Text);
      psTerminated: ShowMessage('Process stopped');
      psErrors: ShowMessage('Process completed with some warnings');
   end;
end;

Handling HTTP redirects in Downloader

procedure TForm1.btnDownloadClick(Sender: TObject);
begin
   Memo1.Lines.Clear();
   FRedirectURL := '';
   clDownLoader.URL := edtURL.Text;
   clDownLoader.Start();
end;

procedure TForm1.clInternetConnectionStatusCallback(Sender: TObject;
   Action: TclInternetAction; AInternetStatus: Integer;
   AStatusInformation: PChar; AStatusInformationLength: Integer);
begin
   if (AInternetStatus = INTERNET_STATUS_REDIRECT) then
   begin
      FRedirectURL := AStatusInformation;
      clDownLoader.Stop();
   end;
end;

procedure TForm1.clDownLoaderProcessCompleted(Sender: TObject);
begin
   if (FRedirectURL <> '') then
   begin
      clDownLoader.URL := FRedirectURL;
      if (clDownLoader.LocalFile = clDownLoader.LocalFolder) then
      begin
         clDownLoader.LocalFile := clDownLoader.LocalFile + 'default.htm';
      end;
      FRedirectURL := '';
      clDownLoader.Start();
   end;
end;

Handling Cookies

procedure TForm1.Button1Click(Sender: TObject);
var
   i: Integer;
   cookie: TclCookieItem;
begin
   for i := clHttp1.Cookies.Count - 1 downto 0 do
   begin
      cookie := clHttp1.Cookies[i];
      if (cookie.Expires <> '') and (MailTimeToDateTime(cookie.Expires) < Now) then
      begin
         clHttp1.Cookies.Delete(i);
      end;
   end;
   clHttp1.Get(edtUrl.Text, memResponse.Lines);
end;

procedure TForm1.clHttp1ReceiveResponse(Sender: TObject; const AMethod,
AUrl: String; AResponseHeader: TStrings; ACookies: TclCookieList);
var
   i: Integer;
   cookie: TclCookieItem;
begin
   for i := 0 to ACookies.Count - 1 do
   begin
      cookie := clHttp1.Cookies.CookieByName(ACookies[i].Name);
      if (cookie = nil) then
      begin
         cookie := clHttp1.Cookies.Add();
      end;
      cookie.Assign(ACookies[i]);
   end;
end;

Handling redirects in HTTP client

procedure TForm1.Button1Click(Sender: TObject);
begin
   memResponse.Lines.Clear();
   memRedirects.Lines.Clear();
   memIPList.Lines.Clear();

   clHttp1.AllowRedirects := cbAllowRedirect.Checked;
   clHttp1.Get(edtUrl.Text, memResponse.Lines);
end;

procedure TForm1.clHttp1Redirect(Sender: TObject; ARequestHeader: TStrings;
   AStatusCode: Integer; AResponseHeader: TclHttpResponseHeader;
   AResponseText: TStrings; var AMethod: String; var CanRedirect,
   Handled: Boolean);
begin
   memRedirects.Lines.Add((Sender as TclHttp).Url.ParsedUrl + ' -> ' + AResponseHeader.Location);
end;

procedure TForm1.clHttp1SendRequest(Sender: TObject; const AMethod,
   AUrl: String; ARequestHeader: TStrings);
begin
   memIPList.Lines.Add((Sender as TclHttp).Url.ParsedUrl + ' - ' + (Sender as TclHttp).Connection.IP);
end;

How to build and send the web form request with the POST method

procedure TfmWebFormPost.btSubmitClick(Sender: TObject);
begin
   clHttpRequest1.Clear();
   clHttpRequest1.AddFormField('Name', 'John Doe');
   clHttpRequest1.AddFormField('BirthDate', '10/10/72');
   clHttpRequest1.AddFormField('Account', '123');

   clUploader1.HTTPRequest := clHttpRequest1;
   clUploader1.UseHTTPRequest := True;
   clUploader1.URL := 'http://www.clevercomponents.com/'
      +'products/inetsuite/demos/serverformpost.asp';

   clUploader1.Start(False);

   ShowMessage(clUploader1.HttpResponse.Text);
end;

How to build and send the submit file request with the POST method

procedure TMain.btSubmitClick(Sender: TObject);
begin
   clUploader1.HTTPRequest := clHttpRequest1;

   clHttpRequest1.Clear();
   clHttpRequest1.AddSubmitFile('Project1.dpr');

   clUploader1.UseHTTPRequest := True;
   clUploader1.URL := 'http://www.clevercomponents.com/'
      + 'products/inetsuite/demos/serversubmitfile.asp';
   clUploader1.Start(False);
end;

Sending the GET Form request

procedure TfmGetFormPost.btnGetClick(Sender: TObject);
begin
   clHttpRequest1.Clear();

   clHttpRequest1.AddFormField('name', 'John');
   clHttpRequest1.AddFormField('account', '12345');

   clDownloader1.URL := 'www.myserver.com/account.asp';
   clDownloader1.HTTPRequest := clHttpRequest1;
   clDownloader1.UseHTTPRequest := True;
   clDownloader1.Start(False);
end;

How to manage mailboxes on IMAP server

procedure TForm1.btnCreateDelClick(Sender: TObject);
begin
   clIMAP4.Server := 'mail.test.com';
   clIMAP4.UserName := 'test';
   clIMAP4.Password := 'test';
   clIMAP4.UseTLS := ctNone;
   clIMAP4.UseSPA := False;
   clIMAP4.Open();

   clIMAP4.CreateMailBox('MyMailbox');
   clIMAP4.SelectMailBox('MyMailbox');
   clIMAP4.DeleteMailBox('MyMailbox');

   clIMAP4.Close();
end;

How to find messages in the selected mailbox on the IMAP server

procedure TForm1.btnFindClick(Sender: TObject);
var
   MsgNumbers: TStrings;
begin
   clIMAP4.Server := 'mail.test.com';
   clIMAP4.UserName := 'test';
   clIMAP4.Password := 'test';
   clIMAP4.UseTLS := ctNone;
   clIMAP4.UseSPA := False;
   clIMAP4.Open();

   clIMAP4.SelectMailBox('MyMailbox');

   MsgNumbers := TStringList.Create();
   try
      clIMAP4.SearchMessages('SUBJECT hello', MsgNumbers);

      ShowMessage(MsgNumbers.Text);
   finally
      MsgNumbers.Free();
   end;

   clIMAP4.Close();
end;

Retrieving a specified message from the IMAP server

procedure TForm1.btnGetClick(Sender: TObject);
var
   MsgNo: Integer;
   MsgUids: TStrings;
begin
   if clIMAP4.Active then Exit;

   clIMAP4.Server := 'mail.test.com';
   clIMAP4.UserName := 'test';
   clIMAP4.Password := 'test';
   clIMAP4.UseSPA := False;
   clIMAP4.Open();

   MsgUids := TStringList.Create();
   try
      clIMAP4.UidSearchMessages('SUBJECT hello', MsgUids);

      MsgNo := 0;
      clIMAP4.UidRetrieveMessage(MsgUids[MsgNo], clMailMessage1);
   finally
      MsgUids.Free();
   end;

   ShowMessage('From: ' + clMailMessage1.From + #13#10 + 'Subject: ' + clMailMessage1.Subject);

   clIMAP4.Close();
end;

Storing a mail message on the IMAP server

procedure TForm1.btnStoreClick(Sender: TObject);
begin
   clIMAP4.Server := 'mail.test.com';
   clIMAP4.UserName := 'test';
   clIMAP4.Password := 'test';
   clIMAP4.Open();

   clMailMessage1.Clear();
   clMailMessage1.From := 'test@test.com';
   clMailMessage1.ToList.Add('support@mywebsite.com');
   clMailMessage1.Subject := 'question';
   clMailMessage1.Bodies.AddText('Text message here');

   clIMAP4.AppendMessage('MyMailBox', clMessageParser1, []);

   clIMAP4.Close();
end;

Saving mail attachments

procedure TForm1.btnLoadClick(Sender: TObject);
var
   msg: TStrings;
begin
   if not OpenDialog1.Execute() then Exit;
   msg := TStringList.Create();
   try
      msg.LoadFromFile(OpenDialog1.FileName);
      clMailMessage1.MessageSource := msg;
   finally
      msg.Free();
   end;
end;

procedure TForm1. clMailMessage1GetDataStream(Sender: TObject;
   ABody: TclMessageBody; const AFileName: String; var AStream: TStream;
   var Handled: Boolean);
begin
   SaveDialog1.FileName := AFileName;
   Handled := SaveDialog1.Execute();
   if not Handled then Exit;
   AStream := TFileStream.Create(SaveDialog1.FileName, fmCreate);
end;

How to build a text mail message with file attachments and send it via SMTP

procedure TForm1.btnSendClick(Sender: TObject);
begin
   clSMTP1. MailMessage := clMailMessage1;

   clSMTP1.Server := 'mail.test.com';
   clSMTP1.UserName := 'test';
   clSMTP1.Password := 'test';
   clSMTP1.UseSPA := False;
   clSMTP1.Open();

   clMailMessage1.BuildMessage('Hello, world !', ['Project1.dpr']);
   clMailMessage1.From := 'testuser@test.com';
   clMailMessage1.ToList.Add('support@mywebsite.com');
   clMailMessage1.Subject := 'Hello';

   clSMTP1.Send();

   clSMTP1.Close();
end;

Deleting a message from the POP3 server

procedure TForm1.btnDeleteClick(Sender: TObject);
var
   msgNo: Integer;
begin
   if clPOP3.Active then Exit;

   clPOP3.Server := 'mail.test.com';
   clPOP3.Password := 'test';
   clPOP3.UserName := 'test';
   clPOP3.UseSPA := False;
   clPOP3.Open();

   msgNo := 1;
   clPOP3.Delete(msgNo);

   clPOP3.Close();
end;

Getting the message retrieving progress with TclPOP3

procedure TForm1.btnDownloadClick(Sender: TObject);
var
   msgNo: Integer;
begin
   if clPOP3.Active then Exit;

   clPOP3.Server := 'mail.test.com';
   clPOP3.Password := 'test';
   clPOP3.UserName := 'test';
   clPOP3.UseTLS := ctNone;
   clPOP3.UseSPA := False;
   clPOP3.Open();

   msgNo := 1;
   ProgressBar1.Position := 0;

   clPOP3.Retrieve(msgNo);

   clPOP3.Close();
end;

procedure TForm1. clPOP3Progress(Sender: TObject; ABytesProceed, ATotalBytes: Integer);
begin
   ProgressBar1.Max := ATotalBytes;
   ProgressBar1.Position := ABytesProceed;
end;

Receiving email messages with a specified index from the server via POP3

procedure TForm1.btnReceiveClick(Sender: TObject);
var
   msgNo: Integer;
begin
   if clPOP3.Active then Exit;

   clPOP3.Server := 'mail.test.com';
   clPOP3.Password := 'test';
   clPOP3.UserName := 'test';
   clPOP3.UseTLS := ctNone;
   clPOP3.UseSPA := False;
   clPOP3.Open();

   clPOP3. MailMessage := clMailMessage1;

   msgNo := 0;
   clPOP3.Retrieve(msgNo);

   ShowMessage(clPOP3. MailMessage.Subject);

   clPOP3.Close();
end;

How to get information about all messages in the mailbox via POP3

procedure TForm1.Button1Click(Sender: TObject);
const
   POP3_OK = 1;
begin
   clPOP3.Server := 'mail.myserver.com';
   clPOP3.UserName := 'test';
   clPOP3.Password := 'test';
   clPOP3.Open();

   clPOP3.SendCommandSync('LIST', [POP3_OK]);
   ShowMessage(clPOP3.Response.Text);

   clPOP3.Close();
end;

Retrieving mail messages to a database

clPop3.UserName := 'user';
clPop3.Password := 'psw';
clPop3.Open();
clPop3.Retrieve(MsgNo);

if not (DataSet1.State in [dsInsert, dsEdit]) then
   DataSet1.Insert();
stream := TMemoryStream.Create();
try
   clPop3.Response.SaveToStream(stream);
   BlobField1.LoadFromStream(stream);
finally
   stream.Free();
end;

DataSet1.Post();

clPop3.UserName := 'user';
clPop3.Password := 'psw';
clPop3.Open();
clPop3.Retrieve(MsgNo, clMailMessage1);

if not (DataSet1.State in [dsInsert, dsEdit]) then
   DataSet1.Insert();

DataSet1.FieldByName('message_id').AsString := clMailMessage1.MessageID;
DataSet1.FieldByName('message_from').AsString := clMailMessage1.From;
DataSet1.FieldByName('message_subject').AsString := clMailMessage1.Subject;
DataSet1.FieldByName('message_date').AsDateTime := clMailMessage1.Date;

textBody := TStringList.Create();
try
   clMailMessage1.GetBodyText(textBody);
   DataSet1.FieldByName('message_text').AsString := textBody.Text;
finally
   textBody.Free();
end;

DataSet1.Post();

Sending mail messages from a database

clSmtp1.UserName := 'user';
clSmtp1.Password := 'passw';
clSmtp1.Open();

DataSet1.First();

while not DataSet1.Eof do
begin
   clSmtp1.MailFrom := DataSet1.FieldByName('message_from').AsString;
   clSmtp1.MailToList.Text := DataSet1.FieldByName('message_to').AsString;
   clSmtp1.MailData.Text := memoField.AsString;
   clSmtp1.Send();
   DataSet1.Next();
end;
clSmtp1.Close();

clSmtp1.UserName := 'user';
clSmtp1.Password := 'passw';
clSmtp1.Open();

DataSet1.First();

while not DataSet1.Eof do
begin
   clMailMessage1.BuildMessage(DataSet1.FieldByName('message_body').AsString, '');
   clMailMessage1.From := DataSet1.FieldByName('message_from').AsString;
   clMailMessage1.ToList.Text := DataSet1.FieldByName('message_to').AsString;
   clMailMessage1.Subject := DataSet1.FieldByName('message_subject').AsString;
   clSmtp1.Send(clMailMessage1);

   DataSet1.Next();
end;
clSmtp1.Close();

How to upload a file via HTTP with the PUT method

procedure TfmUploader.btUploadClick(Sender: TObject);
begin
   if clUploader1.IsBusy then Exit;

   clUploader1.LocalFile := 'Project1.dpr';
   clUploader1.UserName := 'test';
   clUploader1.Password := 'test';
   clUploader1.URL := 'http://www.clevercomponents.com/test/Project1.dpr';
   clUploader1.RequestMethod := 'PUT';
   clUploader1.Start();
end;

How to upload a Delphi stream via FTP with TclUploader

procedure TfmUploader.btUploadClick(Sender: TObject);
begin
   if clUploader1.IsBusy then Exit;
   Memory := TStringStream.Create('test data');
   clUploader1.DataStream := Memory;

   clUploader1.UserName := 'test';
   clUploader1.Password := 'test';
   clUploader1.URL := 'ftp://myserver.com/testdata.txt';
   clUploader1.Start();
end;

procedure TfmUploader.clUploader1ProcessCompleted(Sender: TObject);
begin
   clUploader1.DataStream := nil;
   Memory.Free();
end;

Error Handling in asynchronous mode

procedure TMain.clUploader1StatusChanged(Sender: TObject; Status: TclProcessStatus);
begin
   case Status of
      psSuccess: ShowMessage('Process completed successfully');
      psFailed: ShowMessage((Sender as TclUploader).Errors.Text);
      psTerminated: ShowMessage('Process stopped');
      psErrors: ShowMessage('Process completed with some warnings');
   end;
end;

Working with WebDAV properties

webdav.UserName := 'user';
webdav.Password := 'password';
ns := webdav.NameSpaces.Add();
ns.Prefix := 'Z';
ns.NameSpace := 'mycustomnamespace';

webdav.SetProperties('http://localhost/WebDAV/1.txt', ['Z:tester', 'Z:developer'], ['John Doe', 'Vasya Pupkin']);
webdav.GetProperties('http://localhost/WebDAV/1.txt', ['Z:tester']);
Assert(webdav.ResourceProperties.Count = 1);
Assert(webdav.ResourceProperties[0].Value = 'John Doe');
Assert(webdav.ResourceNameSpaces.ItemByNameSpace('mycustomnamespace') <> nil);
webdav.RemoveProperties('http://localhost/WebDAV/1.txt', ['Z:tester']);
webdav.GetAllProperties('http://localhost/WebDAV/');
Assert(webdav.ResourceProperties.Count > 0);
webdav.Reset();

Working with WebDAV resources and collections

webdav.MakeDir('http://localhost/WebDAV/temp1/');
source := TStringStream.Create('test data');
webdav.Put('http://localhost/WebDAV/temp1/file1.txt', source);
source.Free();

webdav.ListDir('http://localhost/WebDAV/temp1/');
Assert(webdav.ResourceProperties.Count > 0);
Assert(webdav.ResourceProperties.FindItem('http://localhost/WebDAV/temp1/file1.txt', 'getcontentlength') <> nil);

webdav.Copy('http://localhost/WebDAV/temp1/', 'http://localhost/WebDAV/temp2/');
webdav.Delete('http://localhost/WebDAV/temp1/');
webdav.Move('http://localhost/WebDAV/temp2/', 'http://localhost/WebDAV/temp1/');

Working with WebDAV locks

webdav.GetActiveLocks('http://localhost/WebDAV/');
Assert(webdav.ActiveLocks.Count = 0);
Assert(webdav.CurrentLockToken = '');
webdav.LockOwner := 'Clever Tester';
webdav.LockScope := wsExclusive;
Assert(webdav.LockTimeOut <> '');
lockToken := webdav.Lock('http://localhost/WebDAV/1.txt');

webdav.GetActiveLocks('http://localhost/WebDAV/');
Assert(webdav.ActiveLocks.Count > 0);
Assert(webdav.CurrentLockToken <> '');

 
Home  | Site Map  | Products  | Articles  | Downloads  | Order  | Support
 
    Copyright © 2000-2007