CONNECT TO AN FTP SERVER AND DOWNLOAD A FILE

// ******************************************************************
// CONNECT TO AN FTP SERVER AND DOWNLOAD A FILE
// Category        : FTP
// Author          : Thomas Stutz
// Author Email    : tom@swissdelphicenter.ch
// Author Web      : http://www.swissdelphicenter.ch
// Tips Website    : Swiss Delphi Center
// Tips Website URL: http://www.swissdelphicenter.ch
// ******************************************************************

{
The following function shows how to connect to a ftp server
and download a file.
It uses the functions from wininet.dll.

You need a ProgressBar to show the progress and a Label to show progress informations.
}

uses
WinInet, ComCtrls;

function FtpDownloadFile(strHost, strUser, strPwd: string;
Port: Integer; ftpDir, ftpFile, TargetFile: string; ProgressBar: TProgressBar): Boolean;

function FmtFileSize(Size: Integer): string;
begin
if Size >= $F4240 then
Result := Format(‘%.2f’, [Size / $F4240]) + ‘ Mb’
else
if Size < 1000 then
Result := IntToStr(Size) + ‘ bytes’
else
Result := Format(‘%.2f’, [Size / 1000]) + ‘ Kb’;
end;

const
READ_BUFFERSIZE = 4096;  // or 256, 512, …
var
hNet, hFTP, hFile: HINTERNET;
buffer: array[0..READ_BUFFERSIZE - 1] of Char;
bufsize, dwBytesRead, fileSize: DWORD;
sRec: TWin32FindData;
strStatus: string;
LocalFile: file;
bSuccess: Boolean;
begin
Result := False;

{ Open an internet session }
hNet := InternetOpen(‘Program_Name’, // Agent
INTERNET_OPEN_TYPE_PRECONFIG, // AccessType
nil,  // ProxyName
nil, // ProxyBypass
0); // or INTERNET_FLAG_ASYNC / INTERNET_FLAG_OFFLINE

{
Agent contains the name of the application or entity calling the Internet functions
}

{ See if connection handle is valid }
if hNet = nil then
begin
ShowMessage(‘Unable to get access to WinInet.Dll’);
Exit;
end;

{ Connect to the FTP Server }
hFTP := InternetConnect(hNet, // Handle from InternetOpen
PChar(strHost), // FTP server
port, // (INTERNET_DEFAULT_FTP_PORT),
PChar(StrUser), // username
PChar(strPwd),  // password
INTERNET_SERVICE_FTP, // FTP, HTTP, or Gopher?
0, // flag: 0 or INTERNET_FLAG_PASSIVE
0);// User defined number for callback

if hFTP = nil then
begin
InternetCloseHandle(hNet);
ShowMessage(Format(‘Host “%s” is not available’,[strHost]));
Exit;
end;

{ Change directory }
bSuccess := FtpSetCurrentDirectory(hFTP, PChar(ftpDir));

if not bSuccess then
begin
InternetCloseHandle(hFTP);
InternetCloseHandle(hNet);
ShowMessage(Format(‘Cannot set directory to %s.’,[ftpDir]));
Exit;
end;

{ Read size of file }
if FtpFindFirstFile(hFTP, PChar(ftpFile), sRec, 0, 0) <> nil then
begin
fileSize := sRec.nFileSizeLow;
// fileLastWritetime := sRec.lastWriteTime
end else
begin
InternetCloseHandle(hFTP);
InternetCloseHandle(hNet);
ShowMessage(Format(‘Cannot find file ‘,[ftpFile]));
Exit;
end;

{ Open the file }
hFile := FtpOpenFile(hFTP, // Handle to the ftp session
PChar(ftpFile), // filename
GENERIC_READ, // dwAccess
FTP_TRANSFER_TYPE_BINARY, // dwFlags
0); // This is the context used for callbacks.

if hFile = nil then
begin
InternetCloseHandle(hFTP);
InternetCloseHandle(hNet);
Exit;
end;

{ Create a new local file }
AssignFile(LocalFile, TargetFile);
{$i-}
Rewrite(LocalFile, 1);
{$i+}

if IOResult <> 0 then
begin
InternetCloseHandle(hFile);
InternetCloseHandle(hFTP);
InternetCloseHandle(hNet);
Exit;
end;

dwBytesRead := 0;
bufsize := READ_BUFFERSIZE;

while (bufsize > 0) do
begin
Application.ProcessMessages;

if not InternetReadFile(hFile,
@buffer, // address of a buffer that receives the data
READ_BUFFERSIZE, // number of bytes to read from the file
bufsize) then Break; // receives the actual number of bytes read

if (bufsize > 0) and (bufsize <= READ_BUFFERSIZE) then
BlockWrite(LocalFile, buffer, bufsize);
dwBytesRead := dwBytesRead + bufsize;

{ Show Progress }
ProgressBar.Position := Round(dwBytesRead * 100 / fileSize);
Form1.Label1.Caption := Format(‘%s of %s / %d %%’,[FmtFileSize(dwBytesRead),FmtFileSize(fileSize) ,ProgressBar.Position]);
end;

CloseFile(LocalFile);

InternetCloseHandle(hFile);
InternetCloseHandle(hFTP);
InternetCloseHandle(hNet);
Result := True;
end;

ACCESSING HOTMAIL FROM DELPHI

// ******************************************************************
// ACCESSING HOTMAIL FROM DELPHI
// Category        : E-Mail, News
// Author          : DelphiFAQ.com
// Author Email    : tips@delphifaq.com
// Author Web      : http://www.delphifaq.com
// Tips Website    : Delphi FAQ
// Tips Website URL: http://www.delphifaq.com
// ******************************************************************

{
Q:
Is it possible to access a hotmail account through the POP3 and SMTP? I know its
a web frontend but I’d like to write a automated application which can send and
recieve mail using a Hotmail account.

A:
Hotmail isn’t accessable through POP/SMTP. you must use their web interface.
There is no possible shortcut to read mail but you can open the default Hotmail
account in new message mode using this ShellExecute call:
}

program dummy;

var
ToAddress: String;
EightSpaces: String;

begin
ToAddress := ‘john@pacbell.net’;
// Don’t know why but this is required to get the
// correct compose address…
EightSpaces := ‘        ‘;
ShellExecute(Handle, PChar(‘open’), PChar(‘rundll32.exe’),
PChar(‘C:\PROGRA~1\INTERN~1\HMMAPI.DLL,MailToProtocolHandler’
+ EightSpaces + ToAddress), nil, SW_NORMAL)
end.

ADD A BUTTON TO THE INTERNET EXPLORER TOOLBAR

// ******************************************************************
// ADD A BUTTON TO THE INTERNET EXPLORER TOOLBAR
// Category        : Browsers
// Author          : Dave
// Author Email    :
// Author Web      :
// Tips Website    : Swiss Delphi Center
// Tips Website URL: http://www.swissdelphicenter.ch
// ******************************************************************

{
This is a simple little example that allows you to add a button
to Internet Explorer 3.0 or above
Values:
ButtonText := The text you want to be displayed at the bottom of the button
MenuText := The tools option at the top of IE will now contain
a reference to your program.
MenuStatusbar := Script option we are not using this object. (Ignore)
CLSID := Your classID. I won`t explain it because its complex.
That it has to unique. You can use GUIDTOSTRING
To create a new CLSID with the unit ActiveX.

Default Visible := Display it.
Exec := Your program path to execute.
Hoticon := (Mouse Over Event) ImageIndex in shell32.dll i’ve picked 4
Icon := I’ve selected to display shell32.dll image 4.
}

procedure CreateExplorerButton(Path: string);
const
Tagit = ‘\{10954C80-4F0F-11d3-B17C-00C0DFE39736}\’;
var
Reg: TRegistry;
Path1: string;
Merge: string;
begin
Path := ‘c:\your_program_path’;
Reg := TRegistry.Create;
try
with Reg do
begin
RootKey := HKEY_LOCAL_MACHINE;
Path1 := ‘Software\Microsoft\Internet Explorer\Extensions’;
Merge := Path1 + Tagit;
OpenKey(Merge, True);
WriteString(‘ButtonText’, ‘ButtonText’);
WriteString(‘MenuText’, ‘Tools Menu Item’);
WriteString(‘MenuStatusBar’, ‘Run Script’);
WriteString(‘ClSid’, ‘{1FBA04EE-3024-11d2-8F1F-0000F87ABD16}’);
WriteString(‘Default Visible’, ‘Yes’);
WriteString(‘Exec’, Path + ‘\ProgramName.exe’);
WriteString(‘HotIcon’, ‘,4′);
WriteString(‘Icon’, ‘,4′);
end
finally
Reg.CloseKey;
Reg.Free;
end;
end;

EXECUTE A PROGRAM AND HAVE MY CODE WAIT UNTIL IT IS FINISHED

// ******************************************************************
// EXECUTE A PROGRAM AND HAVE MY CODE WAIT UNTIL IT IS FINISHED
// Category        : Task
// Author          : Gustav Evertsson
// Author Email    :
// Author Web      :
// Tips Website    : DelphiTips.com
// Tips Website URL: http://www.delphitips.com
// ******************************************************************

uses Wintypes,WinProcs,Toolhelp,Classes,Forms;

Function WinExecAndWait(Path : string; Visibility : word) : word;
var
InstanceID : THandle;
PathLen : integer;
begin
// inplace conversion of a String to a PChar
PathLen := Length(Path);
Move(Path[1],Path[0],PathLen);
Path[PathLen] := #0;
// Try to run the application
InstanceID := WinExec(@Path,Visibility);
if InstanceID < 32 then    // a value less than 32 indicates an Exec error
WinExecAndWait := InstanceID
else
begin
Repeat
Application.ProcessMessages;
until Application.Terminated or (GetModuleUsage(InstanceID) = 0);
WinExecAndWait := 32;
end;
end;

CHANGE MDI PARENT BACKGROUND

// ******************************************************************
// CHANGE MDI PARENT BACKGROUND
// Category        : MDI
// Author          : Greatis Software
// Author Email    :
// Author Web      : www.greatissoftware.com
// Tips Website    : Greatis Software
// Tips Website URL: http://www.greatis.com/delphi/tips.html
// ******************************************************************

{
The decision consists in interception of the WM_ERASEBKGND, WM_VSCROLL and
WM_HSCROLL messages and is carried out draw of area with the DrawImage procedure
or InvalidateRect procedure.
In procedure CreateWnd is used SetWindowLong procedure for installation of new
procedure of a window.
Don’t forget to remove line
Application.CreateForm(TForm2, Form2) from project file and line
var Form2: TForm2 from unit2.pas file.
}

type
TForm1 = class(TForm)
//  …
private
{ Private declarations }
public
procedure ClientWndProc(var Message: TMessage);
procedure DrawImage;
{ Public declarations }
protected
procedure CreateWnd; override;
end;

var
Form1: TForm1;
NewClient, OldClient: TFarProc;
MyDC: hDC;

implementation

uses unit2;

{$R *.DFM}

procedure TForm1.CreateWnd;
begin
inherited CreateWnd;
NewClient:=MakeObjectInstance(ClientWndProc);
OldClient:=Pointer(GetWindowLong(ClientHandle, GWL_WNDPROC));
SetWindowLong(ClientHandle, GWL_WNDPROC, LongInt(NewClient));
end;

procedure TForm1.DrawImage;
{ This procedure tiles the image on the form’s client area }
var
i, j: Integer;
WndRect, ImageRect: TRect;
Rows, Cols: Integer;
begin
GetWindowRect(ClientHandle, WndRect);
ImageRect:=Image1.ClientRect;
Rows:=WndRect.Bottom div ImageRect.Bottom;
Cols:=WndRect.Right div ImageRect.Right;
with Image1 do
for i:=0 to Rows+1 do
for j:=0 to Cols+1  do
BitBlt(MyDC,j*Picture.Width,i*Picture.Height,Picture.Width,
Picture.Height,Picture.Bitmap.Canvas.Handle,0,0,SRCCOPY);
end;

procedure TForm1.ClientWndProc(var Message: TMessage);
begin
case Message.Msg of
WM_ERASEBKGND:
begin
CallWindowProc(
OldClient,
ClientHandle,
Message.Msg,
Message.wParam,
Message.lParam);
MyDC:=TWMEraseBkGnd(Message).DC;
DrawImage;
Message.Result:=1;
end;
WM_VSCROLL,WM_HSCROLL:
begin
Message.Result:=
CallWindowProc(
OldClient,
ClientHandle,
Message.Msg,
Message.wParam,
Message.lParam);
InvalidateRect(ClientHandle,nil,True);
end;
else
Message.Result:=
CallWindowProc(
OldClient,
ClientHandle,
Message.Msg,
Message.wParam,
Message.lParam);
end;
end;

COLOR AND TIMING OF HINTS

// ******************************************************************
// COLOR AND TIMING OF HINTS
// Category        : Hint/ToolTip
// Author          : Studiebureau Festraets
// Author Email    :
// Author Web      : http://www.festra.com/eng/index.html
// Tips Website    : Delphi Land
// Tips Website URL: http://www.festra.com/eng/index.html
// ******************************************************************

{
In the OnCreate (or in the OnShow) event handler of the main form of the
application, write this code:
}

procedure TForm1.FormCreate(Sender: TObject);
begin
Application.HintColor := clAqua; // or another color
Application.HintPause := 250;    // 250 mSec before hint is shown
Application.HintHidePause:=3000; // hint disappears after 3 secs
end;

ATTACH YOUR FORM TO ANOTHER APPLICATION

// ******************************************************************
// ATTACH YOUR FORM TO ANOTHER APPLICATION
// Category        : Forms
// Author          : Peter Morris
// Author Email    : pete@stuckindoors.com
// Author Web      : http://www.delphicollection.com/public/Tips/PeterMorris/tips
// Tips Website    : Delphi Collection Tips
// Tips Website URL: http://www.delphicollection.com/public/Tips/
// ******************************************************************

{
You just have to override the CreateParams procedure of the desired form. There
you set params.WndParent to the handle of the window you want to attach your
form to.
}

{…} = class(TForm)
{…}
protected
procedure CreateParams( var params: TCreateParams ); override;
{…}

procedure TForm2.Createparams(var params: TCreateParams);
var
aHWnd : HWND;
begin
inherited;
{somehow obtain a valid handle; might be:}
ahWnd := GetForegroundWindow;
{and now:}
params.WndParent := ahWnd;
end;

{
Bogdan Grigorescu – BogdanG@romwest.ro
BG Remote Programming Group
}

ASSIGN TFORM.ICON AT RUN TIME

// ******************************************************************
// ASSIGN TFORM.ICON AT RUN TIME
// Category        : Forms
// Author          : DelphiFAQ.com
// Author Email    : tips@delphifaq.com
// Author Web      : http://www.delphifaq.com
// Tips Website    : Delphi FAQ
// Tips Website URL: http://www.delphifaq.com
// ******************************************************************

{
ImageEdit is not good. Try to get Borland’s Resource Workshop or paint with
paintbrush and use a freeware converter to convert from BMP to ICO, write a
little resource script (*.rc) refering to the ICO file and compile it to *.res
with BRCC.EXE (comes with Delphi).
}

// Use {$R xxx.res} to include it. Then you may use the API function

HICON LoadIcon(
HINSTANCE  hInstance, // handle of application instance
LPCTSTR  lpIconName  // icon-name string or icon resource identifier
);

// Take this handle (HICON) with the message WM_SETICON to assign it to your form:

SendMessage (Form1.Handle, WM_SETICON, false, iconhandle);

// Note: 3rd parameter = icon size (true -> large icon; false -> small icon).