檢查是否為正確的Mac Address格式

function isMacAdrFormat(str: String): boolean;

begin

  Result := False;

  if Length(str) <> 17 then

    Exit;

  Result := ((str[1] in ['0'..'9', 'A'..'F']) and

             (str[2] in ['0'..'9', 'A'..'F']) and

             (str[3] = '-') and

             (str[4] in ['0'..'9', 'A'..'F']) and

             (str[5] in ['0'..'9', 'A'..'F']) and

             (str[6] = '-') and

             (str[7] in ['0'..'9', 'A'..'F']) and

             (str[8] in ['0'..'9', 'A'..'F']) and

             (str[9] = '-') and

             (str[10] in ['0'..'9', 'A'..'F']) and

             (str[11] in ['0'..'9', 'A'..'F']) and

             (str[12] = '-') and

             (str[13] in ['0'..'9', 'A'..'F']) and

             (str[14] in ['0'..'9', 'A'..'F']) and

             (str[15] = '-') and

             (str[16] in ['0'..'9', 'A'..'F']) and

             (str[17] in ['0'..'9', 'A'..'F']));

end;

把idhttp寫成一個執行序

1、在idhttp.OnWork事件裡加Application.ProcessMessages;
在窗體上放個idhttp控件，寫他的OnWork方法。
procedure TForm1.IdHTTP1Work(Sender: TObject; AWorkMode: TWorkMode;
  const AWorkCount: Integer);
begin
Application.ProcessMessages;
end;

2、
   //在主窗體中定義一個線程類
   type
    TMyDownLoad=class(TThread)
    protected
       procedure Execute;override;
       procedure Download;
    end;

type
  TFMain = class(TForm)
  ....

procedure TMyDownLoad.Download;
Var
  UnitName,PathName:String;
  MyStream:TMemoryStream;
  filepath:string;
  IDHTTP: TIDHttp;
begin
IDHTTP:= TIDHTTP.Create(nil);
MyStream:=TMemoryStream.Create;
try
  IdHTTP.Get('http://127.0.0.1/aiyouasp/testcode/11.exe',MyStream);
  except
    showmessage('網絡出錯未能下載完成！');
    MyStream.Free;
    Exit;
  end;
  filepath:=ExtractFilePath(ParamStr(0));
  MyStream.SaveToFile(filepath+'\DownLoadFiles\11.exe');
  MyStream.Free;
  showmessage('下載完成！');
end;
procedure TMyDownLoad.Execute
begin
      inherited;
      Download;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
      TMyDownLoad.Create(false);
end;

XML自定規則的建檔及讀取方法

新增4個TButton，並點兩下加入事件。

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, XMLIntf, msxmldom, XMLDoc, XmlTool;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}
//自定規則的建檔方法1
procedure TForm1.Button1Click(Sender: TObject);
var
  XD: IXMLDocument;
begin
  XD := NewXMLDocument;
  try
    XD.StandAlone := 'yes';
    XD.Encoding := 'UTF-8';
    XD.Options := [doNodeAutoIndent];
    XD.NodeIndentStr := #9;

    //在這裡用with來寫反而比較清楚
    with XD.AddChild('Family') do
    begin
      AddChild('Father').NodeValue := 'Bill Gates';  //子標籤
      AddChild('Mother').NodeValue := 'Lin Chiling';  //子標籤
      with AddChild('My') do   //子標籤
      begin
        Attributes['Name'] := 'Mouse';  //屬性
        Attributes['Age'] := 25;  //屬性
        with AddChild('Wife') do  //子子標籤
        begin
          NodeValue := 'Cat';
          Attributes['Age'] := 23;  //屬性
        end;
        with AddChild('Child') do  //子子標籤
        begin
          NodeValue := 'Mouse II';
          Attributes['Age'] := 1;  //屬性
        end;
        with AddChild('Child') do  //子子標籤
        begin
          NodeValue := 'Mickey Mouse';
          Attributes['Age'] := 15;  //屬性
        end;
        with AddChild('Child') do  //子子標籤
        begin
          NodeValue := 'Donald Duck';
          Attributes['Age'] := 14;  //屬性
        end;
      end;
      with AddChild('Uncle') do  //子標籤
      begin
        Attributes['Age'] := 35;  //屬性
        Attributes['Sex'] := 'Male';  //屬性
        AddChild('Wife').NodeValue := 'Jolin';  //子子標籤
      end;
    end;
    XD.SaveToFile('C:\Test.xml'); //存檔
    showmessage('存檔完成');
  finally
    XD := nil;  //釋放
  end;
end;

//自定規則的建檔方法2
procedure TForm1.Button2Click(Sender: TObject);
var
  XT: TXmlTool;
begin
  XT := TXmlTool.Create;
  try
    XT['/Family//Father'] := 'Bill Gates'; //目前目錄 /Family//
    XT['Mother'] := 'Lin Chiling'; //目前目錄 /Family//
    XT['My//@Name/'] := 'Mouse'; //目前目錄 /Family//MY// 其屬性
    XT['@Age'] := 25;
    XT['Wife//'] := 'Cat'; //目前目錄 /Family//MY//Wife//
    XT['@Age'] := 23;
    XT['../Child//'] := 'Mouse II'; //目前目錄 /Family//MY//Child//
    XT['@Age'] := 1;
    XT['../Child[1]//'] := 'Mickey Mouse'; //目前目錄 /Family//MY//Child// 第2個相同名字
    XT['@Age'] := 15;
    XT['../Child[2]//'] := 'Donald Duck'; //目前目錄 /Family//MY//Child// 第3個相同名字
    XT['@Age'] := 14;
    XT['../../Uncle//@Age'] := 35; //目前目錄 /Family//Uncle// 其屬性
    XT['@Sex'] := 'Male';
    XT['Wife//'] := 'Jolin'; //目前目錄 /Family//Uncle//Wife// 其屬性
    //目錄最後可以不寫//; 如XT['Wife//']->XT['Wife']; 但外加屬性的不行XT['../../Uncle//@Age'];
    XT.SaveToFile('C:\Test.xml');
    showmessage('存檔完成');
  finally
    XT.Free;
  end;
end;

//自定規則的讀取方法1
procedure TForm1.Button3Click(Sender: TObject);
var
  XD: IXMLDocument;
  i: Integer;
begin
  XD := LoadXMLDocument('C:\Test.xml');
  try
    ShowMessage(XD.ChildNodes['Family'].ChildValues['Father']); //內容
    ShowMessage(XD.ChildNodes['Family'].ChildValues['Mother']); //內容
    ShowMessage(XD.ChildNodes['Family'].ChildNodes['My'].Attributes['Name']); //屬性值
    ShowMessage(XD.ChildNodes['Family'].ChildNodes['My'].Attributes['Age']); //屬性值
    ShowMessage(XD.ChildNodes['Family'].ChildNodes['My'].ChildValues['Wife']); //內容
    ShowMessage(XD.ChildNodes['Family'].ChildNodes['My'].ChildNodes['Wife'].Attributes['Age']); //屬性值
    for i := 0 to XD.ChildNodes['Family'].ChildNodes['My'].ChildNodes.Count-1 do
      if XD.ChildNodes['Family'].ChildNodes['My'].ChildNodes[i].NodeName = 'Child' then //如果是Child
      begin
        ShowMessage(XD.ChildNodes['Family'].ChildNodes['My'].ChildNodes[i].NodeValue); //內容
        ShowMessage(XD.ChildNodes['Family'].ChildNodes['My'].ChildNodes[i].Attributes['Age']); //屬性值
      end;
    ShowMessage(XD.ChildNodes['Family'].ChildNodes['Uncle'].Attributes['Age']); //屬性值
    ShowMessage(XD.ChildNodes['Family'].ChildNodes['Uncle'].Attributes['Sex']); //屬性值
    ShowMessage(XD.ChildNodes['Family'].ChildNodes['Uncle'].ChildValues['Wife']); //內容
  finally
    XD := nil;
  end;
end;

//自定規則的讀取方法2
procedure TForm1.Button4Click(Sender: TObject);
var
  XT: TXmlTool;
begin
  XT := TXmlTool.Create('C:\Test.xml');
  try
    ShowMessage(XT['/Family//Father']); //內容
    ShowMessage(XT['Mother']); //內容
    if XT.SubNodes['My/'].First then
      repeat
        ShowMessage('1. '+XT.SubNodes['My/'].NodeXPath + '=' + XT.SubNodes['My/'].NodeValue); //My Name、Age及Wife、Child值
        if XT.SubNodes['My/'].SubNodes.First then
          repeat
            ShowMessage('2. '+XT.SubNodes['My/'].NodeXPath + '=' + XT.SubNodes['My/'].SubNodes.NodeValue); //Wife、Child的Age值
          until not XT.SubNodes['My/'].SubNodes.Next;
      until not XT.SubNodes['My/'].Next;
    ShowMessage(XT['Uncle//@Age']);   //屬性
    ShowMessage(XT['@Sex']);   //屬性
    ShowMessage(XT['Wife']);   //內容
  finally
    XT.Free;
  end;
end;

end.

抓取網頁所有連結

須新增一個TListBox、1個TButton、1個TWebBrowser。
加入事件TButton點兩下，TWebBrowser的OnDocumentComplete事件點兩下

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, OleCtrls, SHDocVw;

type
  TForm1 = class(TForm)
    WebBrowser1: TWebBrowser;
    Button1: TButton;
    ListBox1: TListBox;
    procedure Button1Click(Sender: TObject);
    procedure WebBrowser1DocumentComplete(Sender: TObject;
      const pDisp: IDispatch; var URL: OleVariant);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
begin
  WebBrowser1.Navigate('http://tw.yahoo.com');
end;

procedure TForm1.WebBrowser1DocumentComplete(Sender: TObject;
  const pDisp: IDispatch; var URL: OleVariant);
var
  i:integer;
begin
  for i := 0 to WebBrowser1.OleObject.Document.links.Length - 1 do
    Listbox1.Items.Add(Webbrowser1.OleObject.Document.Links.Item(i));
end;

end.

TIdTCPServer & Client 傳檔工具

Server程式
須要新增1個按鈕TButton、2個TLabel、1個TLsitBox屬性PopupMenu=PopupMenu1及屬性MultiSelect=true、1個TOpenDialog、1個TPopupMenu、1個TIdTCPServer屬性Bindings=:9999及屬性DefaltPort=9999，並加入OnExecute

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Menus, StdCtrls, IdBaseComponent, IdComponent, IdTCPServer,
  IdThreadMgr, IdThreadMgrDefault;

type
  TForm1 = class(TForm)
    IdTCPServer1: TIdTCPServer;
    ListBox1: TListBox;
    Label1: TLabel;
    Label2: TLabel;
    Button1: TButton;
    OpenDialog1: TOpenDialog;
    PopupMenu1: TPopupMenu;
    N1: TMenuItem;
    N2: TMenuItem;
    procedure Button1Click(Sender: TObject);
    procedure IdTCPServer1Execute(AThread: TIdPeerThread);
    procedure FormCreate(Sender: TObject);
    procedure N1Click(Sender: TObject);
    procedure N2Click(Sender: TObject);
  private
    FConnectionCount: Integer;
    procedure IncrConnectionCount;
    procedure DecrConnectionCount;
    { Private declarations }
  public
    { Public declarations }
  end;

function SendString(Sender: Tobject; iMsg: string): Boolean;
function SendFile(Sender: Tobject; iFileName: string): Boolean;

var
  Form1: TForm1;
  AppPath: string;

implementation

{$R *.dfm}

//傳送訊息出去
function SendString(Sender: Tobject; iMsg: string): Boolean;
var
  AStream: TStringStream;
  AThread: TIdPeerThread;
begin
  AThread := (sender as TIdPeerThread);
  AStream := TStringStream.Create(iMsg);
  try
    AThread.Connection.OpenWriteBuffer;
    AThread.Connection.WriteStream(AStream);
    AThread.Connection.CloseWriteBuffer;
    result := true;
  finally
    AStream.Free;
  end;
end;

//傳送檔案出去
function SendFile(Sender: Tobject; iFileName: string): Boolean;
var
  FStream: TFileStream;
  AThread: TIdPeerThread;
  i: integer;
  itmpFileName: string;
begin
  //========依client 所傳的檔名取出server 端的完整路徑檔名

  for i := 0 to Form1.Listbox1.Count - 1 do
    if iFileName = UpperCase(ExtractFileName(Form1.ListBox1.Items.Strings[i])) then
      itmpFileName := Form1.ListBox1.Items.Strings[i];

  //=============================================
  AThread := (sender as TIdPeerThread);

  if itmpFileName = '' then
  begin
    AThread.Connection.WriteLn('Filename not fount!');
    result:=False;
    exit;
  end;
  FStream := TfileStream.Create(itmpFileName, fmOpenRead);
  try
    AThread.Connection.OpenWriteBuffer;
    FStream.Seek(0, soFromBeginning);
    AThread.Connection.WriteStream(FStream, False, False, FStream.Size);
    AThread.Connection.CloseWriteBuffer;
    result := true;
  finally
    FStream.Free;
  end;
end;

procedure TForm1.IncrConnectionCount;
begin
    Inc(FConnectionCount);
    Label2.Caption := '連線數：' + IntToStr(FConnectionCount); //顯示連線數
end;

procedure TForm1.DecrConnectionCount;
begin
    Dec(FConnectionCount);
    Label2.Caption := '連線數：' + IntToStr(FConnectionCount); //顯示連線數
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  OpenDialog1.Execute; //開啟檔案盒
  ListBox1.Items.AddStrings(OpenDialog1.Files); //將所選檔案累加至ListBox1
end;

procedure TForm1.IdTCPServer1Execute(AThread: TIdPeerThread);
var
  SRequest: string;
  //SOutline: string;
  //AStream: TStringStream;
  //FStream: TFileStream;
  //i: integer;
begin

  AThread.Synchronize(IncrConnectionCount);

  AThread.Connection.WriteLn('Welcome to Auto Update Server');
  try
    SRequest := UpperCase(AThread.Connection.ReadLn);

    //檔案資訊
    if SRequest = 'GETFILEINFO' then
      SendString(AThread, ListBox1.Items.Text); //傳給Client檔名

    //傳送檔案
    if SRequest = 'GETFILE' then //傳檔需求
    begin
      AThread.Connection.WriteLn('FILENAME?'); //尋問要取那一個檔
      SRequest := UpperCase(AThread.Connection.ReadLn);
      SendFile(AThread, SRequest);
    end;

  finally
    AThread.Connection.Disconnect;
    AThread.Synchronize(DecrConnectionCount);
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  IdTCPServer1.Active := True; //啟動Server
  AppPath := GetCurrentDir; //先取得程式執行目錄，並儲存
  OpenDialog1.Options := [ofAllowMultiSelect]; //檔案對話框多選

  //載入下載檔案列表
  if FileExists(AppPath + '\UpdateFiles.txt') then
    listbox1.Items.LoadFromFile(AppPath + '\UpdateFiles.txt');
end;

procedure TForm1.N1Click(Sender: TObject);
begin
  ListBox1.SelectAll; //全選
end;

procedure TForm1.N2Click(Sender: TObject);
var
  i: integer;
begin
  for i := ListBox1.Count - 1 downto 0 do //由最後一筆開始刪index才不會出錯
    if ListBox1.Selected[i] = True then
      ListBox1.Items.Delete(i);
end;
end.

Client程式
5個TLabel、2個TPanel、3個TEdit(都有初始文字；請參考圖)、1個TButton、1個TListBox及1個TIdTCPClient

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient,
  StdCtrls, ExtCtrls;

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    Label1: TLabel;
    Label2: TLabel;
    Edit1: TEdit;
    Edit2: TEdit;
    Button1: TButton;
    ListBox1: TListBox;
    Panel2: TPanel;
    Label3: TLabel;
    Edit3: TEdit;
    Label4: TLabel;
    Label5: TLabel;
    IdTCPClient1: TIdTCPClient;
    procedure Button1Click(Sender: TObject);
  private
    procedure GetFiles(SaveFilePath: string; iFileName: string);
    function GetFileName(): TStrings;
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}
//-----------讀取檔案列表-------------
function TForm1.GetFileName(): TStrings;
var
  AStream: TStringStream;
  SResponse: string;
begin
  AStream := TStringStream.Create('');
  result := TStringList.Create;
  try
    IdTCPClient1.Connect();
    SResponse := UpperCase(IdTCPClient1.ReadLn); //讀取伺服器回應
    if Pos('WELCOME', SResponse) = 0 then exit; //若無回應則離開


    IdTCPClient1.WriteLn('GETFILEINFO'); //讀取檔案資訊
    IdTCPClient1.ReadStream(AStream, -1, True);
    AStream.Seek(0, soFromBeginning);
    result.LoadFromStream(AStream);
  finally
    AStream.Free;
    IdTCPClient1.Disconnect;
  end;
end;

procedure TForm1.GetFiles(SaveFilePath: string; iFileName: string);
var
  FStream: TFileStream;
  SResponse: string;
begin
  try
    IdTCPClient1.Connect();
    while IdTCPClient1.Connected do
    begin
      SResponse := UpperCase(IdTCPClient1.ReadLn); //讀取伺服器回應
      if Pos('WELCOME', SResponse) = 0 then
        break; //若無回應則離開

      IdTCPClient1.WriteLn('GETFILE');
      SResponse := UpperCase(IdTCPClient1.ReadLn); //讀取伺服器回應
      IdTCPClient1.WriteLn(iFileName);
      FStream := TFileStream.Create(SaveFilePath + '\' + iFileName, fmCreate);
      try
        FStream.Seek(0, soFromBeginning);
        IdTCPClient1.ReadStream(FStream, -1, True);
      finally
          FStream.Free;
      end;
    end;
  finally
    IdTCPClient1.Disconnect;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  tmpFileName: string;
  i: Integer;
begin
  IdTCPClient1.Host := Edit1.Text;
  IdTCPClient1.Port := strtoint(Edit2.Text);
  listbox1.Items := GetFileName; //取得檔名
 label5.Caption  :='傳檔中，請稍候....';
  for i := 0 to listbox1.Count - 1 do
  begin
    tmpFileName := ExtractFileName(Listbox1.Items.Strings[i]);
    GetFiles(IncludeTrailingBackslash(Edit3.Text), tmpFileName);
  end;
 label5.Caption  :='傳檔完成....';
end;
end.

Ping工具

視窗上有
2個TLabel、1個TEdit、1個TMemo、1個TButton、1個LMDSpinEdit1，然後再放一個IdIcmpClient元件(在IndyClient那裡)
然後在Button的onClick點兩下，及IdIcmpClient元件上點兩下，最後加入下列程式碼：

procedure TForm1.Button1Click(Sender: TObject);
var
  i: integer;
begin
  IdIcmpClient1.OnReply := IdIcmpClient1Reply; //設置回應屬性
  IdIcmpClient1.ReceiveTimeout := 1000; //設置連線時間
  Button1.Enabled := False; //禁止按鈕
  try
    IdIcmpClient1.Host := Edit1.Text; //輸入Edit1的Host
    for i := 1 to LMDSpinEdit1.Value do begin //開始連線次數迴圈
      IdIcmpClient1.Ping; //開始連線
      Application.ProcessMessages; //發送訊息
      //sleep(1000);//可加入暫停一秒
    end;
  finally
    Button1.Enabled := True; //恢復按鈕
  end;
end;

procedure TForm1.IdIcmpClient1Reply(ASender: TComponent;
  const AReplyStatus: TReplyStatus);
var
  sTime: string;
begin
  // TODO: check for error on ping reply (ReplyStatus.MsgType?)
  if (AReplyStatus.MsRoundTripTime = 0) then
    sTime := '<1'
  else
    sTime := '=';

  Memo1.Lines.Add(Format('IP位址=%s bytes=%d ICMP_seq=%d TTL=%d 存在時間%s%d豪秒',
   [AReplyStatus.FromIpAddress,  //IP位址
   AReplyStatus.BytesReceived, //Bytes
   AReplyStatus.SequenceId,
   AReplyStatus.TimeToLive, //TTL
   sTime,
   AReplyStatus.MsRoundTripTime])); //時間
end;

簡單寫本機Port掃描器

首先可能要增加之前的元件
[ components ] --> [ install packages ] --> [ add ] --> choose C:\Program Files\Borlad\BDS\4.0\Bin\dclsockets100.bpl
接著在Internet就會多個TServerSocket。
然後開始設計視窗：
2個Label、2個Edit、1個Button、1個Memo、1個ProgressBar、1個TServerSocket、1個StatusBar
並將TServerSocket的Active屬性變成true。
最後在Button的onClick事件加入下列程式碼：

procedure TForm1.Button1Click(Sender: TObject);
var
  a:integer; //a為整數
begin
  Button1.Enabled:=false;
  StatusBar1.SimpleText:='掃描中…請稍等…';//當按鈕按下時狀態列出現掃瞄中字樣
  ProgressBar1.max:=strtoint(Edit2.Text)-strtoint(Edit1.Text);
  ProgressBar1.Position:=0;//初始狀態是0
  Memo1.Clear; //當按鈕按下時Memo1的內容清空
  for a:=strtoint(Edit1.Text) to strtoint(Edit2.Text) do
  begin
    ProgressBar1.Position:=a-strtoint(Edit1.Text);
    ServerSocket1.Close;
    ServerSocket1.Port:=a;//Port為整數a
    try
      ServerSocket1.Open;
    except
      Memo1.Lines.Add('Port '+inttostr(a)+'是打開的');//當Port出現重複時 Memo1會出現提示end;
      StatusBar1.SimpleText:='正在掃描Port'+inttostr(a);//狀態列會出現正在掃描哪個Port
    end;
  end;
  StatusBar1.SimpleText:='掃描完畢';//掃描完之後出現掃描完畢字樣
  ProgressBar1.Position:=0;//初始狀態是0
  Button1.Enabled:=true;
end;

SMTP寄信程式

首先 我們先在Form上放下列元件:
7個Edit、7個Label、1個Button、1個Memo、1個IdSMTP(在Indy Client裡)、1個IdMessage(在Indy Misc裡)
接著就編輯Button1的onClick程式碼(以下內容):

procedure TForm1.Button1Click(Sender: TObject);
begin
  try
    IdSMTP1.AuthenticationType:=atLogin; //登陸類型
    IdSMTP1.Username:=Edit1.Text; //使用者帳號
    IdSMTP1.Password:=Edit2.Text; //使用者密碼
    IdSMTP1.Host:=Edit3.Text; //SMTP伺服器位址
    IdSMTP1.Port:=strtoint(Edit4.Text); //SMTP埠必須轉換為整數
    IdSMTP1.Connect;
  except
    Showmessage('連線失敗!!');
    Exit;
  end;
  IdMessage1.Body.Clear;//清除上次信件內容
  IdMessage1.Body.Assign(Memo1.Lines);//信件內容
  IdMessage1.From.Address:=Edit5.Text;//發信人地址
  IdMessage1.Recipients.EMailAddresses:=Edit6.Text;//收信人地址
  IdMessage1.Subject:=Edit7.Text;//信件主旨
  try
    IdSMTP1.Send(IdMessage1);
    showmessage('發送成功!!');
  except
    showmessage('發送失敗!!有問題了!!');
  end;
end;

若要加入密碼

uses
    IdSASLLogin, IdUserPassProvider;

var
  IdSASLLogin1    :TIdSASLLogin;
  LHlogin         :TIdUserPassProvider;
begin
  IdSASLLogin1    :=TIdSASLLogin.Create();
  LHlogin         :=TIdUserPassProvider.Create();
  IdSMTP1.Username:=sUsername;
  IdSMTP1.Password:=sPassword;
  LHlogin.Username:=sUsername;
  LHlogin.Password:=sPassword;
  IDSMTP1.AuthType:=atSASL;
  IdSMTP1.SASLMechanisms.Add.SASL:=IdSASLLogin1;
  IdSASLLogin1.UserPassProvider:=LHlogin;


  try
    IdSMTP1.Connect;

    //IDSMTP1.ConnectTimeout := 1000;
    //IdSMTP1.Connect(1000);
    if IdSMTP1.Connected then
    begin

      if (Length(sUsername)) > 0 then
      begin
        if not IdSMTP1.Authenticate then
        begin
          //DebugStr('@@驗證失敗');//'郵件伺服器驗證失敗!'
          exit;
        end;
      end;
      IdSMTP1.Send(IdMessage1);  //寄出報表
    end;

  finally
    if IdSMTP1.Connected then IdSMTP1.Disconnect;
  end;

計算字串及檔案的md5

因為網路上常須計算md5值作驗證，所以我把它規到網際網路這裡。
首先須先加入md5.pas到你的專案內。

接著新增二個Label、三個Button、及二個Edit還有一個Memo跟OpenDialog

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Edit1: TEdit;
    Edit2: TEdit;
    Label1: TLabel;
    Label2: TLabel;
    Memo1: TMemo;
    OpenDialog1: TOpenDialog;
    procedure Button1Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
var
  Form1: TForm1;

implementation

{$R *.dfm}
uses
  md5;
function LogEntry(Cmd, Msg: string; Dig: MD5Digest): string;
begin
 Result := Format('%s(''%s'') =' + #13#10 + '   %s', [Cmd, Msg, MD5Print(Dig)]); //以後要拿來用就MD5Print(Edit1.Text)
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  Memo1.Lines.add(LogEntry('MD5String', Edit1.Text, MD5String(Edit1.Text)));
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
  if OpenDialog1.Execute then
    Edit2.Text := OPenDialog1.FileName;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
 Screen.Cursor := crHourGlass;
  Memo1.Lines.add(LogEntry('MD5File', Edit2.Text, MD5File(Edit2.Text)));
 Screen.Cursor := crDefault;
end;

end.

md5.pas

unit md5;

// ------------------------------------------------------------------
interface
// ------------------------------------------------------------------

uses
 Windows;

type
 MD5Count = array[0..1] of DWORD;
 MD5State = array[0..3] of DWORD;
 MD5Block = array[0..15] of DWORD;
 MD5CBits = array[0..7] of byte;
 MD5Digest = array[0..15] of byte;
 MD5Buffer = array[0..63] of byte;
 MD5Context = record
  State: MD5State;
  Count: MD5Count;
  Buffer: MD5Buffer;
 end;

procedure MD5Init(var Context: MD5Context);
procedure MD5Update(var Context: MD5Context; Input: pChar; Length: longword);
procedure MD5Final(var Context: MD5Context; var Digest: MD5Digest);

function MD5String(M: string): MD5Digest;
function MD5File(N: string): MD5Digest;
function MD5Print(D: MD5Digest): string;

function MD5Match(D1, D2: MD5Digest): boolean;

// ------------------------------------------------------------------
IMPLEMENTATION
// ------------------------------------------------------------------
var
 PADDING: MD5Buffer = (
  $80, $00, $00, $00, $00, $00, $00, $00,
  $00, $00, $00, $00, $00, $00, $00, $00,
  $00, $00, $00, $00, $00, $00, $00, $00,
  $00, $00, $00, $00, $00, $00, $00, $00,
  $00, $00, $00, $00, $00, $00, $00, $00,
  $00, $00, $00, $00, $00, $00, $00, $00,
  $00, $00, $00, $00, $00, $00, $00, $00,
  $00, $00, $00, $00, $00, $00, $00, $00
 );

function F(x, y, z: DWORD): DWORD;
begin
 Result := (x and y) or ((not x) and z);
end;

function G(x, y, z: DWORD): DWORD;
begin
 Result := (x and z) or (y and (not z));
end;

function H(x, y, z: DWORD): DWORD;
begin
 Result := x xor y xor z;
end;

function I(x, y, z: DWORD): DWORD;
begin
 Result := y xor (x or (not z));
end;

procedure rot(var x: DWORD; n: BYTE);
begin
 x := (x shl n) or (x shr (32 - n));
end;

procedure FF(var a: DWORD; b, c, d, x: DWORD; s: BYTE; ac: DWORD);
begin
 inc(a, F(b, c, d) + x + ac);
 rot(a, s);
 inc(a, b);
end;

procedure GG(var a: DWORD; b, c, d, x: DWORD; s: BYTE; ac: DWORD);
begin
 inc(a, G(b, c, d) + x + ac);
 rot(a, s);
 inc(a, b);
end;

procedure HH(var a: DWORD; b, c, d, x: DWORD; s: BYTE; ac: DWORD);
begin
 inc(a, H(b, c, d) + x + ac);
 rot(a, s);
 inc(a, b);
end;

procedure II(var a: DWORD; b, c, d, x: DWORD; s: BYTE; ac: DWORD);
begin
 inc(a, I(b, c, d) + x + ac);
 rot(a, s);
 inc(a, b);
end;

// ------------------------------------------------------------------
// Encode Count bytes at Source into (Count / 4) DWORDs at Target
procedure Encode(Source, Target: pointer; Count: longword);
var
 S: PByte;
 T: PDWORD;
 I: longword;
begin
 S := Source;
 T := Target;
 for I := 1 to Count div 4 do begin
  T^ := S^;
  inc(S);
  T^ := T^ or (S^ shl 8);
  inc(S);
  T^ := T^ or (S^ shl 16);
  inc(S);
  T^ := T^ or (S^ shl 24);
  inc(S);
  inc(T);
 end;
end;

// Decode Count DWORDs at Source into (Count * 4) Bytes at Target
procedure Decode(Source, Target: pointer; Count: longword);
var
 S: PDWORD;
 T: PByte;
 I: longword;
begin
 S := Source;
 T := Target;
 for I := 1 to Count do begin
  T^ := S^ and $ff;
  inc(T);
  T^ := (S^ shr 8) and $ff;
  inc(T);
  T^ := (S^ shr 16) and $ff;
  inc(T);
  T^ := (S^ shr 24) and $ff;
  inc(T);
  inc(S);
 end;
end;

// Transform State according to first 64 bytes at Buffer
procedure Transform(Buffer: pointer; var State: MD5State);
var
 a, b, c, d: DWORD;
 Block: MD5Block;
begin
 Encode(Buffer, @Block, 64);
 a := State[0];
 b := State[1];
 c := State[2];
 d := State[3];
 FF (a, b, c, d, Block[ 0],  7, $d76aa478);
 FF (d, a, b, c, Block[ 1], 12, $e8c7b756);
 FF (c, d, a, b, Block[ 2], 17, $242070db);
 FF (b, c, d, a, Block[ 3], 22, $c1bdceee);
 FF (a, b, c, d, Block[ 4],  7, $f57c0faf);
 FF (d, a, b, c, Block[ 5], 12, $4787c62a);
 FF (c, d, a, b, Block[ 6], 17, $a8304613);
 FF (b, c, d, a, Block[ 7], 22, $fd469501);
 FF (a, b, c, d, Block[ 8],  7, $698098d8);
 FF (d, a, b, c, Block[ 9], 12, $8b44f7af);
 FF (c, d, a, b, Block[10], 17, $ffff5bb1);
 FF (b, c, d, a, Block[11], 22, $895cd7be);
 FF (a, b, c, d, Block[12],  7, $6b901122);
 FF (d, a, b, c, Block[13], 12, $fd987193);
 FF (c, d, a, b, Block[14], 17, $a679438e);
 FF (b, c, d, a, Block[15], 22, $49b40821);
 GG (a, b, c, d, Block[ 1],  5, $f61e2562);
 GG (d, a, b, c, Block[ 6],  9, $c040b340);
 GG (c, d, a, b, Block[11], 14, $265e5a51);
 GG (b, c, d, a, Block[ 0], 20, $e9b6c7aa);
 GG (a, b, c, d, Block[ 5],  5, $d62f105d);
 GG (d, a, b, c, Block[10],  9,  $2441453);
 GG (c, d, a, b, Block[15], 14, $d8a1e681);
 GG (b, c, d, a, Block[ 4], 20, $e7d3fbc8);
 GG (a, b, c, d, Block[ 9],  5, $21e1cde6);
 GG (d, a, b, c, Block[14],  9, $c33707d6);
 GG (c, d, a, b, Block[ 3], 14, $f4d50d87);
 GG (b, c, d, a, Block[ 8], 20, $455a14ed);
 GG (a, b, c, d, Block[13],  5, $a9e3e905);
 GG (d, a, b, c, Block[ 2],  9, $fcefa3f8);
 GG (c, d, a, b, Block[ 7], 14, $676f02d9);
 GG (b, c, d, a, Block[12], 20, $8d2a4c8a);
 HH (a, b, c, d, Block[ 5],  4, $fffa3942);
 HH (d, a, b, c, Block[ 8], 11, $8771f681);
 HH (c, d, a, b, Block[11], 16, $6d9d6122);
 HH (b, c, d, a, Block[14], 23, $fde5380c);
 HH (a, b, c, d, Block[ 1],  4, $a4beea44);
 HH (d, a, b, c, Block[ 4], 11, $4bdecfa9);
 HH (c, d, a, b, Block[ 7], 16, $f6bb4b60);
 HH (b, c, d, a, Block[10], 23, $bebfbc70);
 HH (a, b, c, d, Block[13],  4, $289b7ec6);
 HH (d, a, b, c, Block[ 0], 11, $eaa127fa);
 HH (c, d, a, b, Block[ 3], 16, $d4ef3085);
 HH (b, c, d, a, Block[ 6], 23,  $4881d05);
 HH (a, b, c, d, Block[ 9],  4, $d9d4d039);
 HH (d, a, b, c, Block[12], 11, $e6db99e5);
 HH (c, d, a, b, Block[15], 16, $1fa27cf8);
 HH (b, c, d, a, Block[ 2], 23, $c4ac5665);
 II (a, b, c, d, Block[ 0],  6, $f4292244);
 II (d, a, b, c, Block[ 7], 10, $432aff97);
 II (c, d, a, b, Block[14], 15, $ab9423a7);
 II (b, c, d, a, Block[ 5], 21, $fc93a039);
 II (a, b, c, d, Block[12],  6, $655b59c3);
 II (d, a, b, c, Block[ 3], 10, $8f0ccc92);
 II (c, d, a, b, Block[10], 15, $ffeff47d);
 II (b, c, d, a, Block[ 1], 21, $85845dd1);
 II (a, b, c, d, Block[ 8],  6, $6fa87e4f);
 II (d, a, b, c, Block[15], 10, $fe2ce6e0);
 II (c, d, a, b, Block[ 6], 15, $a3014314);
 II (b, c, d, a, Block[13], 21, $4e0811a1);
 II (a, b, c, d, Block[ 4],  6, $f7537e82);
 II (d, a, b, c, Block[11], 10, $bd3af235);
 II (c, d, a, b, Block[ 2], 15, $2ad7d2bb);
 II (b, c, d, a, Block[ 9], 21, $eb86d391);
 inc(State[0], a);
 inc(State[1], b);
 inc(State[2], c);
 inc(State[3], d);
end;

// ------------------------------------------------------------------
// Initialize given Context
procedure MD5Init(var Context: MD5Context);
begin
 with Context do begin
  State[0] := $67452301;
  State[1] := $efcdab89;
  State[2] := $98badcfe;
  State[3] := $10325476;
  Count[0] := 0;
  Count[1] := 0;
  ZeroMemory(@Buffer, SizeOf(MD5Buffer));
 end;
end;

// Update given Context to include Length bytes of Input
procedure MD5Update(var Context: MD5Context; Input: pChar; Length: longword);
var
 Index: longword;
 PartLen: longword;
 I: longword;
begin
 with Context do begin
  Index := (Count[0] shr 3) and $3f;
  inc(Count[0], Length shl 3);
  if Count[0] < (Length shl 3) then inc(Count[1]);
  inc(Count[1], Length shr 29);
 end;
 PartLen := 64 - Index;
 if Length >= PartLen then begin
  CopyMemory(@Context.Buffer[Index], Input, PartLen);
  Transform(@Context.Buffer, Context.State);
  I := PartLen;
  while I + 63 < Length do begin
   Transform(@Input[I], Context.State);
   inc(I, 64);
  end;
  Index := 0;
 end else I := 0;
 CopyMemory(@Context.Buffer[Index], @Input[I], Length - I);
end;

// Finalize given Context, create Digest and zeroize Context
procedure MD5Final(var Context: MD5Context; var Digest: MD5Digest);
var
 Bits: MD5CBits;
 Index: longword;
 PadLen: longword;
begin
 Decode(@Context.Count, @Bits, 2);
 Index := (Context.Count[0] shr 3) and $3f;
 if Index < 56 then PadLen := 56 - Index else PadLen := 120 - Index;
 MD5Update(Context, @PADDING, PadLen);
 MD5Update(Context, @Bits, 8);
 Decode(@Context.State, @Digest, 4);
 ZeroMemory(@Context, SizeOf(MD5Context));
end;

// ------------------------------------------------------------------
// Create digest of given Message
function MD5String(M: string): MD5Digest;
var
 Context: MD5Context;
begin
 MD5Init(Context);
 MD5Update(Context, pChar(M), length(M));
 MD5Final(Context, Result);
end;

// Create digest of file with given Name
function MD5File(N: string): MD5Digest;
var
 FileHandle: THandle;
 MapHandle: THandle;
 ViewPointer: pointer;
 Context: MD5Context;
begin
 MD5Init(Context);
 FileHandle := CreateFile(pChar(N), GENERIC_READ, FILE_SHARE_READ or FILE_SHARE_WRITE,
  nil, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL or FILE_FLAG_SEQUENTIAL_SCAN, 0);
 if FileHandle <> INVALID_HANDLE_VALUE then try
  MapHandle := CreateFileMapping(FileHandle, nil, PAGE_READONLY, 0, 0, nil);
  if MapHandle <> 0 then try
   ViewPointer := MapViewOfFile(MapHandle, FILE_MAP_READ, 0, 0, 0);
   if ViewPointer <> nil then try
    MD5Update(Context, ViewPointer, GetFileSize(FileHandle, nil));
   finally
    UnmapViewOfFile(ViewPointer);
   end;
  finally
   CloseHandle(MapHandle);
  end;
 finally
  CloseHandle(FileHandle);
 end;
 MD5Final(Context, Result);
end;

// Create hex representation of given Digest
function MD5Print(D: MD5Digest): string;
var
 I: byte;
const
 Digits: array[0..15] of char =
  ('0', '1', '2', '3', '4', '5', '6', '7', '8', '9', 'a', 'b', 'c', 'd', 'e', 'f');
begin
 Result := '';
 for I := 0 to 15 do Result := Result + Digits[(D[I] shr 4) and $0f] + Digits[D[I] and $0f];
end;

// -----------------------------------------------------------------------------------------------

// Compare two Digests
function MD5Match(D1, D2: MD5Digest): boolean;
var
 I: byte;
begin
 I := 0;
 Result := TRUE;
 while Result and (I < 16) do begin
  Result := D1[I] = D2[I];
  inc(I);
 end;
end;
end.

網頁瀏覽器製作

新增元件
1. 須新增"上一頁"、"下一頁"、"停止"、"更新"、"進入網站"共五個TButton
2. 一個TEdit輸入網址用
3. 顯示網頁的元件TWebBrowser
4. 顯示目前進度的TGauge
5. 一個TLabel顯示處理進度文字

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, OleCtrls, SHDocVw, Gauges;

type
  TForm1 = class(TForm)
    WebBrowser1: TWebBrowser;
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    Edit1: TEdit;
    Label1: TLabel;
    Button5: TButton;
    Gauge1: TGauge;
    procedure FormActivate(Sender: TObject);
    procedure Edit1KeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
    procedure WebBrowser1ProgressChange(ASender: TObject; Progress,
      ProgressMax: Integer);
    procedure WebBrowser1CommandStateChange(ASender: TObject; Command: Integer;
      Enable: WordBool);
    procedure WebBrowser1NavigateComplete2(ASender: TObject;
      const pDisp: IDispatch; var URL: OleVariant);
    procedure Button4Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);

  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

//上一頁
procedure TForm1.Button1Click(Sender: TObject);
begin
  WebBrowser1.GoBack;
end;

//下一頁
procedure TForm1.Button2Click(Sender: TObject);
begin
  WebBrowser1.GoForward ;
end;

//停止
procedure TForm1.Button3Click(Sender: TObject);
begin
  WebBrowser1.Stop;
end;

//更新
procedure TForm1.Button4Click(Sender: TObject);
begin
  WebBrowser1.Refresh ;
end;

//進入網站
procedure TForm1.Button5Click(Sender: TObject);
begin
  WebBrowser1.Navigate(Edit1.Text);
end;

//當鍵盤按Enter
procedure TForm1.Edit1KeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if key=13 then Button5.Click ;
end;

//當視窗活動時，設定焦點，記得focus都要在Activate才能設喔!
procedure TForm1.FormActivate(Sender: TObject);
begin
    Edit1.SetFocus ;
end;

//網頁連結成功，網址列顯示URL
procedure TForm1.WebBrowser1NavigateComplete2(ASender: TObject;
  const pDisp: IDispatch; var URL: OleVariant);
begin
  Edit1.Text:=URL;
end;

//處理進度情況設定
procedure TForm1.WebBrowser1ProgressChange(ASender: TObject; Progress,
  ProgressMax: Integer);
begin
  Gauge1.MaxValue :=ProgressMax;
  Gauge1.Progress:=progress;
end;

//上一頁及下一頁按紐判斷可否被按
procedure TForm1.WebBrowser1CommandStateChange(ASender: TObject;
  Command: Integer; Enable: WordBool);
begin
  if (Command = CSC_NAVIGATEFORWARD) then
    Button3.Enabled := Enable
  else if (Command = CSC_NAVIGATEBACK) then
    Button2.Enabled := Enable
end;

end.

用Webbrowser讀取網頁

使用方法，開啟專案，加入一個TWebBrowser TButton TMemo，然後貼上下列程式碼，之後在元件TWebBrowser事件WebBrowser1DocumentComplete 及 TButton元件上點兩下即可。 IHTMLDocument2此元件為mshtml;

unit readhtmleasy;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, IdBaseComponent, IdComponent, IdTCPConnection,
IdTCPClient, IdHTTP, OleCtrls, SHDocVw, mshtml, Grids, ComCtrls, StrUtils,activex;

type
TForm1 = class(TForm)
Button1: TButton;
Memo1: TMemo;
WebBrowser1: TWebBrowser;
procedure Button1Click(Sender: TObject);

private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
var
  slTemp: TStringList;
  HTMLDoc: IHTMLDocument2;
begin
  Cursor := crHourGlass;
  webbrowser1.Navigate('http://www.stockq.org');
  HTMLDoc := webbrowser1.Document as IHTMLDocument2;

  while Webbrowser1.ReadyState <> READYSTATE_COMPLETE do
    Application.ProcessMessages;

  Cursor := crDefault;
  HTMLDoc := webbrowser1.Document as IHTMLDocument2;
  slTemp := TStringList.Create;
  slTemp.text := HTMLDoc.body.innertext;
  memo1.text :=  slTemp.text;
end;
end.