activex组件 java Delphi写的ASP组件 源程序

1234567890ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz 這是Base64編碼法的測試檔案, 請同時執行Delphi版的Base64編碼,並比 較Java版的編碼結果是否正確。 unit Unit1; interface uses ComObj, ActiveX, AspTlb, myMail_TLB, StdVcl,Windows, Classes, SysUtils, Encode, IniFiles, scktcomp; const St_1 = '收信人的地址不正確!!'; St_2 = '寄信人的地址不正確!!'; St_3 = '未寫寄信人的名稱!!'; St_4 = '未寫信件標題!!'; St_5 = '信件內容為空白的!!'; St_6 = '寄信郵件主機無法連線，可能忙線中或有錯誤!!'; St_7 = '寄信郵件主機的Port(通常為25)錯誤!!'; St_8 = '寄信郵件主機尚未設定或設定有錯誤!!'; St_111 = '信件已經成功寄出... :-)'; LocalProgram = 'ASP myMail.SendMail v2.30 by Shanfeng 2000-08-28'; Version = 'myMail SendMail v2.30 中文版'; Copyright = 'Copyright (c) 2000 Shanfeng. All rights reserved.'; License = '禁止以本軟體圖利於他人。'; // 三種邊界字串 Boundary1 = '----=_MultiPart_Boundary_001_by_myMail_SendMail'; Boundary2 = '----=_MultiPart_Boundary_002_by_myMail_SendMail'; Boundary3 = '----=_MultiPart_Boundary_003_by_myMail_SendMail'; //換行符號 crlf = #13#10; WeekDays: array [1..7] of string[3] = ('Sun', 'Mon', 'Tue', 'Wed', 'Thu', 'Fri', 'Sat'); Months: array [1..12] of string[3] = ('Jan', 'Feb', 'Mar', 'Apr', 'May', 'Jun', 'Jul', 'Aug', 'Sep', 'Oct', 'Nov', 'Dec'); type TSendMail = class(TASPObject, ISendMail) private ClientSocket1: TClientSocket; Host: String; Port: Integer; From: String; Sender: String; ReplyTo: String; Subject: String; BodyType: String; BodyFilePath: String; Status: String; CharSet: String; ContentBase: String; ContentPath: String; Recipient: TStrings; RecipientName: TStrings; ToCarbonCopy: TStrings; ToBlindCarbonCopy: TStrings; BodyText: TStrings; AttachFiles: TStrings; HtmlImages: TStrings; MsgStrings: TStrings; Priority: Integer; isBase64: Boolean; UseBase: Boolean; procedure GetHTMLImages; function EncodeQuotedPrintable(text: String): String; function GetMIMEType(FileName : string) : string; procedure MakeMsgStrings; function GetTextFromSock: String; protected procedure OnEndPage; safecall; procedure OnStartPage(const AScriptingContext: IUnknown); safecall; function Get_Connect: Integer; safecall; function Get_ContentType(const Filename: WideString): WideString; safecall; function Get_Host: WideString; safecall; function Get_NowDateTime: WideString; safecall; function Get_Port: Integer; safecall; function Get_Send: Integer; safecall; function Get_Status: WideString; safecall; function Get_Version: WideString; safecall; procedure Clear; safecall; procedure Set_AttachFile(const Value: WideString); safecall; procedure Set_BodyText(const Value: WideString); safecall; procedure Set_BodyType(const Value: WideString); safecall; procedure Set_CharSet(const Value: WideString); safecall; procedure Set_From(const Value: WideString); safecall; procedure Set_Host(const Value: WideString); safecall; procedure Set_Port(Value: Integer); safecall; procedure Set_To_(const Value: WideString); safecall; procedure Set_Sender(const Value: WideString); safecall; procedure Set_Subject(const Value: WideString); safecall; procedure Set_Bcc(const Value: WideString); safecall; procedure Set_Cc(const Value: WideString); safecall; procedure Set_HtmlImage(const Value: WideString); safecall; procedure Set_ToName(const Value: WideString); safecall; procedure Set_ReplyTo(const Value: WideString); safecall; procedure Set_Priority(Value: Integer); safecall; procedure Set_Base64(Value: WordBool); safecall; procedure Set_ContentBase(const Value: WideString); safecall; procedure Set_ContentPath(const Value: WideString); safecall; function Get_ContentBase: WideString; safecall; function Get_ContentPath: WideString; safecall; procedure Set_UseBase(Value: WordBool); safecall; procedure Set_BodyFile(const filename: WideString); safecall; end; implementation uses ComServ; ///////////////////////////////////////////////////////////////// // 物件外部程序與函數 // ///////////////////////////////////////////////////////////////// //利用寄件者的主機名稱與一個數字製作簡單的CID function GetCID(From: String; Num: Integer): String; { From 寄件者E-Mail Num 任意數字, 在一份信件中不同的圖片不可用相同的數字 } begin //將cid傳回 Result := Format('%.8x', [Num])+ Copy(From, Pos('@', From), Length(From)); end; //將HTML碼中的圖片名稱轉換成cid的形式 function ImgNameToCID(text, From: String; ImgNames: TStrings): String; { text 信件內容字串 From 寄信者 ImgNames 圖片名稱 } var HTMLTxt: String; //HTML文件內容字串 lcHTMLTxt: String; //小寫字母的HTML文件內容字串 ImgName: String; //HTML文件內的圖片名稱 pos1: Integer; //HTML文件內的圖片名稱所在的位置 lop: Integer; //迴圈變數 newCID: String; //產生新的cid CIDs: TStrings; //記錄使用過的cid begin //取得HTML的所有程式碼 HTMLTxt := text; CIDs := TStringList.Create; // 對每一個圖片檔名做處理 for lop:=0 to ImgNames.Count-1 do begin //ImgNames已經全部轉成小寫 //取出圖片名程, 純檔名不含路徑 ImgName := ExtractFileName(ImgNames[lop]); //將HTML碼全部轉成小寫字母 lcHTMLTxt := LowerCase(HTMLTxt); // 找出每一行中的所有圖片檔名(在HTML中顯示的圖片) pos1 := Pos(ImgName, lcHTMLTxt); while pos1>0 do begin // 將HTML中的圖片檔名刪除, 並插入 cid //目前只處理以下這幾種情形 if (Copy(lcHTMLTxt, pos1-4, 4)='src=') or (Copy(lcHTMLTxt, pos1-5, 5)='src="') or (Copy(lcHTMLTxt, pos1-5, 5)='src=''') or (Copy(lcHTMLTxt, pos1-11, 11)='background=') or (Copy(lcHTMLTxt, pos1-12, 12)='background="') or (Copy(lcHTMLTxt, pos1-5, 5)='background=''') then begin // 如果有相同檔名的圖片, 其cid也應該相同, CIDs中記錄著前面的cid // 遇到相同檔名便直接使用這個cid, 否則產生一個新的cid if CIDs.IndexOfName(ImgName)=-1 then begin newCID := GetCID(From, lop); CIDs.Add(ImgName + '=' + newCID); end else newCID := CIDs.Values[ImgName]; // 刪除圖片檔名 Delete(HTMLTxt, pos1, Length(ImgName)); // 插入cid Insert('cid:' + newCID, HTMLTxt, pos1); // 找尋下一個目前圖片檔名字串 lcHTMLTxt := LowerCase(HTMLTxt); pos1 := Pos(ImgName, lcHTMLTxt); end else begin // 將不是用於顯示圖片的圖片檔名暫時更改名稱, // 以免這些字串造成無窮迴圈 Delete(lcHTMLTxt, pos1, 1); Insert('@', lcHTMLTxt, pos1); pos1 := Pos(ImgName, lcHTMLTxt); end; end; end; CIDs.Free; // 將處理完成的字串傳回 Result := HTMLTxt; end; //對附加檔或圖片檔進行編碼 //目前只支援Base64與UUEncode兩種 function DoEncode(fileName: String; isBase64: Boolean): TMemoryStream; { fileName 要進行編碼的檔名及完整路徑 isBase64 是否以 Base64編碼法來進行編碼 } var Base64: TBase64Encode; // Base64編碼法的物件 UU: TUUEncode; // UUEncode編碼法的物件 begin Result := TMemoryStream.Create; // 進行編碼 if isBase64 then begin // 記得要傳入一個TMemoryStream以便能得到編碼結果 Base64 := TBase64Encode.Create(Result); // 由於在 TBase64Encode類別中提供了直接傳檔案進入的方式 // 因此在使用時只要傳入檔案名稱即可得到已編碼的資料 Base64.WriteFile(fileName); Base64.Free; end else begin // 使用方式與Base64同 UU := TUUEncode.Create(Result); UU.WriteFile(fileName); UU.Free; end; //這�堶n將Stream的位置歸0 Result.Position := 0; end; ///////////////////////////////////////////////////////////////// // TSendMail // ///////////////////////////////////////////////////////////////// // 由已連線的Socket讀取資料 function TSendMail.GetTextFromSock: String; var SockStream: TWi