Jump to content

mazluta

Members
  • Content Count

    41
  • Joined

  • Last visited

Community Reputation

1 Neutral

Recent Profile Visitors

The recent visitors block is disabled and is not being shown to other users.

  1. thanks for you replay. this is not the solution. just to be clear. if i send the POST without the Attachment, the mail online is open. the problem is in the attachment array. i tried to send full path (from onedrive upload), fileID, linkID, webURL.... dont no what to try more. chatGPT and Gimini are looping over and over... the Microsoft stuff send you to articles that send you to more articles...
  2. Is there anyone that tried to open mail online with attachment? 1. get AccessToken from Graph API with clientID, ApplicationID +++ (that work) 2. upload file to onedrive. (that work) 3. get sharelink. (that work) 4. open /me/message (that FAIL) 5. the subject will be empty, the body empty. 6. the user can add more files. 7. the user can add recipients, subject, body..... 8. click on send. i have mange to get the AccessToken. Upload the file to ondrive/temp folder get the sharelink but i can not draft the message. CHATGPT - professional - did not help. GIMINI - Advance - the same MICROSOFT - like to make living harder this is the log ============ CreateSharingLink - Response Status Code: 200 CreateSharingLink - Response Body: {"@odata.context":"https://graph.microsoft.com/v1.0/$metadata#microsoft.graph.permission","id":"6977e500-5d45-47cc-82e8-d6ea3ceeef8d","roles":["read"],"shareId":"u!aHR0cHM6Ly9oYW5pYmFhbGNvaWwtbXkuc2hhcmVwb2ludC5jb20vOmI6L2cvcGVyc29uYWwvbWF6bHV0YV9oYW5pYmFhbF9jb19pbC9FVS1BSU1VOTU1UkJsX0RveDhrUlBUUUJGZDBXNmlOcVY3bEljQlVYcTMwME5R","hasPassword":false,"link":{"scope":"organization","type":"view","webUrl":"https://hanibaalcoil-my.sharepoint.com/:b:/g/personal/mazluta_hanibaal_co_il/EU-AIMU955RBl_Dox8kRPTQBFd0W6iNqV7lIcBUXq300NQ","preventsDownload":false}} CreateSharingLink - HTTP Protocol version Version: 2 CreateSharingLink - Result.webUrl = https://hanibaalcoil-my.sharepoint.com/:b:/g/personal/mazluta_hanibaal_co_il/EU-AIMU955RBl_Dox8kRPTQBFd0W6iNqV7lIcBUXq300NQ CreateSharingLink - Result.shareId = u!aHR0cHM6Ly9oYW5pYmFhbGNvaWwtbXkuc2hhcmVwb2ludC5jb20vOmI6L2cvcGVyc29uYWwvbWF6bHV0YV9oYW5pYmFhbF9jb19pbC9FVS1BSU1VOTU1UkJsX0RveDhrUlBUUUJGZDBXNmlOcVY3bEljQlVYcTMwME5R UploadAndOpenMailWithAttachment - Share URL created: https://hanibaalcoil-my.sharepoint.com/:b:/g/personal/mazluta_hanibaal_co_il/EU-AIMU955RBl_Dox8kRPTQBFd0W6iNqV7lIcBUXq300NQ UploadAndOpenMailWithAttachment - Share ID: u!aHR0cHM6Ly9oYW5pYmFhbGNvaWwtbXkuc2hhcmVwb2ludC5jb20vOmI6L2cvcGVyc29uYWwvbWF6bHV0YV9oYW5pYmFhbF9jb19pbC9FVS1BSU1VOTU1UkJsX0RveDhrUlBUUUJGZDBXNmlOcVY3bEljQlVYcTMwME5R UploadAndOpenMailWithAttachment - JSON Request: { "subject": "Document from DMS", "body": { "contentType": "HTML", "content": "Please review the attached file." }, "attachments": [ { "@odata.type": "#microsoft.graph.referenceAttachment", "name": "GettingStarted.pdf", "sourceUrl": "https://graph.microsoft.com/v1.0/shares/u!aHR0cHM6Ly9oYW5pYmFhbGNvaWwtbXkuc2hhcmVwb2ludC5jb20vOmI6L2cvcGVyc29uYWwvbWF6bHV0YV9oYW5pYmFhbF9jb19pbC9FVS1BSU1VOTU1UkJsX0RveDhrUlBUUUJGZDBXNmlOcVY3bEljQlVYcTMwME5R/root/content", "isInline": false } ]} UploadAndOpenMailWithAttachment - Create Draft Response Code: 400 UploadAndOpenMailWithAttachment - Create Draft Response Body: {"error":{"code":"UnableToDeserializePostBody","message":"were unable to deserialize "}} UploadAndOpenMailWithAttachment - Error creating draft. UploadAndOpenMailWithAttachment - Finished the main procedure : ============ procedure TMainForm.UploadAndOpenMailWithAttachment(const LocalFilePath: string); var HttpClient: THttpClient; OneDriveWebURL: string; AttachFileId: string; SharingLinkRec: TSharingLinkRec; DraftId: string; JSONRequestDraft: string; DraftResponse: IHTTPResponse; Headers: TNetHeaders; RequestContent: TStringStream; begin AppLog.Lines.Add(''); AppLog.Lines.Add('UploadAndOpenMailWithAttachment - Starting'); HttpClient := THttpClient.Create; try if UploadFileToOneDrive(LocalFilePath, OneDriveWebURL, AttachFileId) then begin AppLog.Lines.Add('UploadAndOpenMailWithAttachment - File uploaded to OneDrive'); SharingLinkRec := CreateSharingLink(AttachFileId); if SharingLinkRec.Found then begin AppLog.Lines.Add('UploadAndOpenMailWithAttachment - Share URL created: ' + SharingLinkRec.webUrl); AppLog.Lines.Add('UploadAndOpenMailWithAttachment - Share ID: ' + SharingLinkRec.shareId); JSONRequestDraft := '{' + ' "subject": "Document from DMS",' + ' "body": {' + ' "contentType": "HTML",' + ' "content": "Please review the attached file."' + ' },' + ' "attachments": [' + ' {' + ' "@odata.type": "#microsoft.graph.referenceAttachment",' + //' "name": "' + JsonEscape(j_FileName(LocalFilePath)) + '",' + ' "name": "' + j_FileName(LocalFilePath) + '",' + ' "sourceUrl": "https://graph.microsoft.com/v1.0/shares/' + SharingLinkRec.shareId + '/root/content",' + // **Corrected sourceUrl** ' "isInline": false' + ' }' + ' ]' + '}'; AppLog.Lines.Add('UploadAndOpenMailWithAttachment - JSON Request: ' + JSONRequestDraft); SetLength(Headers, 2); Headers[0].Name := 'Authorization'; Headers[0].Value := 'Bearer ' + FAccessToken; Headers[1].Name := 'Content-Type'; Headers[1].Value := 'application/json'; RequestContent := TStringStream.Create(JSONRequestDraft, TEncoding.UTF8); try DraftResponse := HttpClient.Post('https://graph.microsoft.com/v1.0/me/messages', RequestContent, nil, Headers); AppLog.Lines.Add('UploadAndOpenMailWithAttachment - Create Draft Response Code: ' + IntToStr(DraftResponse.StatusCode)); AppLog.Lines.Add('UploadAndOpenMailWithAttachment - Create Draft Response Body: ' + DraftResponse.ContentAsString); if (DraftResponse.StatusCode = 200) or (DraftResponse.StatusCode = 201) then begin // Extract the draft ID (you already have this function) DraftId := ExtractDraftIdFromResponse(DraftResponse.ContentAsString); AppLog.Lines.Add('UploadAndOpenMailWithAttachment - DraftId: ' + DraftId); // Open the draft in Outlook UniSession.AddJS(Format('window.open("https://outlook.office.com/mail/deeplink/compose?itemid=%s&exvsurl=1", "_blank");', [DraftId])); end else begin AppLog.Lines.Add('UploadAndOpenMailWithAttachment - Error creating draft.'); end; finally RequestContent.Free; end; end else begin AppLog.Lines.Add('UploadAndOpenMailWithAttachment - Failed to create shareable link.'); end; end else begin AppLog.Lines.Add('UploadAndOpenMailWithAttachment - Error uploading file to OneDrive.'); end; finally HttpClient.Free; end; AppLog.Lines.Add('UploadAndOpenMailWithAttachment - Finished'); AppLog.Lines.Add(''); end; this is the upload ============ function TMainForm.UploadFileToOneDrive(const LocalFilePath: string; out OneDriveWebURL : string; out AttachFileId : string) : Boolean; var HttpClient: THttpClient; FileStream: TFileStream; FileSize: Int64; UploadURL: string; Response: IHTTPResponse; Headers: TNetHeaders; OneDriveItemJSON: TJSONObject; Success: Boolean; begin Success := False; Result := False; AppLog.Lines.Add(''); AppLog.Lines.Add(''); OneDriveWebURL := ''; AttachFileId := ''; Try HttpClient := THttpClient.Create; try FileStream := TFileStream.Create(LocalFilePath, fmOpenRead or fmShareDenyNone); try FileSize := FileStream.Size; UploadURL := 'https://graph.microsoft.com/v1.0/me/drive/root:/Temp/' + ExtractFileName(LocalFilePath) + ':/content'; SetLength(Headers, 2); Headers[0].Name := 'Authorization'; Headers[0].Value := 'Bearer ' + FAccessToken; Headers[1].Name := 'Content-Type'; Headers[1].Value := 'application/octet-stream'; // Adjust if needed Response := HttpClient.Put(UploadURL, FileStream, nil, Headers); AppLog.Lines.Add('ResponseCode (Upload) := ' + IntToStr(Response.StatusCode)); AppLog.Lines.Add('ResponseBody (Upload) := ' + Response.ContentAsString); if (Response.StatusCode = 200) or (Response.StatusCode = 201) then begin OneDriveItemJSON := TJSONObject.ParseJSONValue(Response.ContentAsString) as TJSONObject; try if Assigned(OneDriveItemJSON) then begin OneDriveWebURL := OneDriveItemJSON.GetValue('webUrl').Value; AttachFileId := OneDriveItemJSON.GetValue('id').Value; AppLog.Lines.Add(''); AppLog.Lines.Add('OneDrive Web URL: ' + OneDriveWebURL); AppLog.Lines.Add(''); Success := True; end; finally OneDriveItemJSON.Free; end; end else begin AppLog.Lines.Add('Error uploading file to OneDrive. Status Code: ' + IntToStr(Response.StatusCode)); // Optionally log the full error response end; finally FileStream.Free; end; finally HttpClient.Free; end; Result := Success; AppLog.Lines.Add(''); AppLog.Lines.Add(''); Except; Result := False; End; end; this is the createShareLink Proc ==================== function TMainForm.CreateSharingLink(const FileId: string): TSharingLinkRec; var HttpClient: THttpClient; Payload: TStringStream; Response: IHTTPResponse; JsonObj: TJSONObject; begin Result.webUrl := ''; Result.shareId := ''; Result.Found := False; HttpClient := THttpClient.Create; try HttpClient.CustomHeaders['Authorization'] := 'Bearer ' + FAccessToken; HttpClient.ContentType := 'application/json'; AppLog.Lines.Add(''); AppLog.Lines.Add('HttpClient.CustomHeaders[Authorization] : ' + HttpClient.CustomHeaders['Authorization'] ); AppLog.Lines.Add('HttpClient.ToString : ' + HttpClient.ToString ); AppLog.Lines.Add(''); Payload := TStringStream.Create('{"type":"view","scope":"organization"}', TEncoding.UTF8); try Response := HttpClient.Post( 'https://graph.microsoft.com/v1.0/me/drive/items/' + FileId + '/createLink', Payload); AppLog.Lines.Add('CreateSharingLink - Response Status Code: ' + IntToStr(Response.StatusCode)); AppLog.Lines.Add('CreateSharingLink - Response Body: ' + Response.ContentAsString); AppLog.Lines.Add('CreateSharingLink - HTTP Protocol version Version: ' + VarToStr(Response.Version)); if (Response.StatusCode = 200) or (Response.StatusCode = 201) then begin JsonObj := TJSONObject.ParseJSONValue(Response.ContentAsString) as TJSONObject; try Result.webUrl := JsonObj.GetValue<TJSONObject>('link').GetValue<string>('webUrl'); Result.shareId := JsonObj.GetValue<string>('shareId'); finally JsonObj.Free; end; end else begin AppLog.Lines.Add('Failed to create sharing link: ' + Response.StatusText); AppLog.Lines.Add('Response Content: ' + Response.ContentAsString); end; finally Payload.Free; end; finally HttpClient.Free; end; AppLog.Lines.Add('CreateSharingLink - Result.webUrl = ' + Result.webUrl); AppLog.Lines.Add('CreateSharingLink - Result.shareId = ' + Result.shareId); Result.Found := (Trim(Result.webUrl) <> '') And (Trim(Result.shareId) <> ''); end;
  3. some one ask in UNIGUI forum about how to check if file is really what the extension "said". does MyFile.DocX is really Word DocX file. Since i Have DMS (Data Management System) and it all about files and document i have a pascal unit just for that. any one how will use it can do with it what he want + i don't take any responsibility for any use of this unit. add the unit to the uses class. call : if IsFileTypeAsClaim('c:\aa\a1.mkv' {full file name and path}) then showmessage('file is ok.') else showmessage('The file is not of the declared type.'); uCheckFileType.pas
  4. this is the solution https://forums.unigui.com/index.php?/topic/36456-upload-file-to-the-server-for-indexing-in-the-server-using-browser-unigui-application/#comment-169303
  5. yes. sorry. office - internet - cloud server. the desktop will be installed in any of the clients 10-50 per day. 5 users. since i new to web development i would like to hear what the masters idea
  6. Hi David. yes, you right. Since the Server (UNIGUI) is always running i thought to use it as "FTP". on the Desktop App var HTTP: TIdHTTP; FormData: TIdMultipartFormDataStream; url : string; FilePath : string; ResultInt : Int64; begin Try HTTP := TIdHTTP.Create(nil); FormData := TIdMultipartFormDataStream.Create; try FilePath := 'c:\a\M1.pdf'; URL := PrmUrlAddress + ':' + IntToStr(PrmUrlPort) + '/Indexing'; ResultInt := GetUniqueNumber; JustWriteToLog('url=' + url); JustWriteToLog('ResultInt=' + IntToStr(ResultInt)); FormData.AddFile('file', FilePath, 'application/octet-stream'); // 'file' is the form field name expected by the server FormData.AddFormField('UniqueName', IntToStr(ResultInt)); HTTP.Post(URL, FormData); // URL is the endpoint, e.g., http://yourserver:port/upload ShowMessage('File uploaded successfully - Status Code = ' + IntToStr(HTTP.ResponseCode)); ShowMessage('Response Text = ' + HTTP.ResponseText); except on E: Exception do ShowMessage('Failed to upload file: ' + E.Message); end; Finally FormData.Free; HTTP.Free; End; and on the server (UNIGUI) Var FileStream: TFileStream; SavePath : string; FileFirstName : String; FormData: TIdMultiPartFormDataStream; begin if ARequestInfo.URI = '/Indexing' then begin FormData := TIdMultiPartFormDataStream.Create; FileFirstName := The Extra PARAM Field SavePath := 'C:\a\' + FileFirstName + '.pdf'; FileStream := TFileStream.Create(SavePath, fmCreate); try // Copy the incoming data to the file stream FileStream.CopyFrom(ARequestInfo.PostStream, ARequestInfo.PostStream.Size); finally FileStream.Free; end; AResponseInfo.ResponseText := 'File Saved OK'; Handled := True; end; end; then after getting 200 status from the server, send another one with the unique no and go to indexing process.
  7. I have a document management system (DMS) written in Delphi UNIGUI. I have a scanning system with many capabilities written in Delphi DESKTOP. I want to scan with the DeskTop application and when finished send the scanned file to the server (Unigui) to perform the filing on the server. The server should receive the file, save it in the temporary area and pop up a filing screen. What is the best way to do it?
  8. Hi. thanks for your answer. i close the Firewall. i close the AV. i add inbound roll to open port TCP 8090 for CORS it should "Ask" the server in the local for permition and i respond "OK" for CORS, but it did not rich to this "question". i even don't know what is blocking? where is it blocking? who is blocking>
  9. i have rest server witch listen to port 8090. it suppose to get JSON with some params. i have web APP that run in some domain - www.hanibaal-test.co.il the server is in localhost :8090 on the client side i do : procedure TSignedDocumentsFrm.DoSignDocument_CA(PdfFileName : String); var HttpClient : TNetHTTPClient; Response : IHTTPResponse; JsonData : TStringStream; AppUrl : String; ResultPdfFileName : String; SignServerAddress : String; PdfBase64 : String; JpgBase64 : String; EncrtpPassWord : String; begin PdfBase64 := dm_Image.ImgToBase64(PdfFileName); JpgBase64 := dm_Image.ImgToBase64(UniMainModule.UserDataRec.User_Logo_FileName); EncrtpPassWord := EncryptStringCK(UniMainModule.UserDataRec.User_TokenPassword, AppEncryPass); JustWriteToLog('EncrtpPassWord = ' + EncrtpPassWord); SignServerAddress := UniMainModule.UserDataRec.User_CA_Sign_HttpAddrs + ':' + IntToStr(UniMainModule.UserDataRec.User_CA_Sign_Port) + '/sign'; JustWriteToLog('SignServerAddress : ' + SignServerAddress); Try JsonData := TStringStream.Create('{"PdfBase64Type": "base64", ' + ' "PdfBase64": "' + PdfBase64 + '", ' + ' "JpgBase64Type": "base64",' + ' "JpgBase64": "' + JpgBase64 + '", ' + ' "LogoTop": ' + IntToStr(UniMainModule.UserDataRec.User_Logo_Top) + ',' + ' "LogoLeft": ' + IntToStr(UniMainModule.UserDataRec.User_Logo_Left) + ',' + ' "LogoWidth": ' + IntToStr(UniMainModule.UserDataRec.User_Logo_Width) + ',' + ' "LogoHeight": ' + IntToStr(UniMainModule.UserDataRec.User_Logo_Height) + ',' + ' "CheckTokenStr": "' + UniMainModule.UserDataRec.User_Token_SerialNO + '",' + ' "CardSerialNO": "' + UniMainModule.UserDataRec.User_Token_SerialNO + '",' + ' "EncrptPassword": "' + EncrtpPassWord + '",' + ' "ReasonToSign": "' + UniMainModule.UserDataRec.User_SignReason + '",' + ' "ImageOpacity": ' + IntToStr(UniMainModule.UserDataRec.User_ImageOpacity) + '}', TEncoding.UTF8); AppUrl := UniApplication.UniSession.URL; if AppUrl[Length(AppUrl)] = '/' then begin AppUrl[Length(AppUrl)] := ' '; AppUrl := Trim(AppUrl); end; HttpClient := TNetHTTPClient.Create(nil); //HttpClient.CustomHeaders['Origin'] := AppUrl;; HttpClient.CustomHeaders['Content-Type'] := 'application/x-www-form-urlencoded'; HttpClient.PreemptiveAuthentication := true; JustWriteToLog('After Set HttpClient Origin to : ' + AppUrl); // Set request content type to JSON HttpClient.ContentType := 'application/json'; //HttpClient.Accept := 'application/json'; // Send POST request with JSON data JustWriteToLog('Before Post Data to Server'); JustWriteToLog('JsonData = ' + JsonData.ToString); Response := HttpClient.Post(SignServerAddress, JsonData); // Check response if Response.StatusCode = 200 then begin ResultPdfFileName := RemoveBackSlashChar(UniServerModule.LocalCachePath) + '\MyResult.Pdf'; Base64ToPDF(Response.ContentAsString,ResultPdfFileName); //JustWriteToLog(Response.ContentAsString); //ShowMessage('Response: ' + Response.ContentAsString); end else begin ShowMessage('Error: ' + Response.StatusText); end; finally JsonData.Free; HttpClient.Free; end; end; on the server side i have : procedure TMyWebModule.WebModuleBeforeDispatch(Sender: TObject; Request: TWebRequest; Response: TWebResponse; var Handled: Boolean); begin JustWriteToLog('start dispath'); JustWriteToLog('Request.Method = ' + Request.Method); Response.CustomHeaders.Values['Access-Control-Allow-Origin'] := '*'; Response.CustomHeaders.Values['Access-Control-Allow-Headers'] := 'Origin, X-Requested-With, Content-Type, Accept'; Response.CustomHeaders.Values['Access-Control-Allow-Methods'] := 'GET, POST, PUT, DELETE, OPTIONS'; Response.CustomHeaders.Values['Access-Control-Allow-Credentials'] := 'true'; Response.CustomHeaders.Values['Access-Control-Allow-Private-Network'] := '*'; Response.CustomHeaders.Values['Access-Control-Expose-Headers'] := ''; Response.CustomHeaders.Values['Access-Control-Max-Age'] := '86400'; JustWriteToLog('On WebModuleBeforeDispatch - After Set Response.SetCustomHeader Access-Control-Allow-Origin' ); if Trim(Request.GetFieldByName('Access-Control-Request-Headers')) <> '' then begin JustWriteToLog('On WebModuleBeforeDispatch - Trim(Request.GetFieldByName(Access-Control-Request-Headers))'); Response.CustomHeaders.Values['Access-Control-Allow-Headers'] := Request.GetFieldByName('Access-Control-Request-Headers'); Handled := True; end; if SameText(Request.Method, 'OPTIONS') then begin JustWriteToLog('On WebModuleBeforeDispatch - if SameText(Request.Method, Option)'); Response.StatusCode := 204; // No Content Handled := True; end; end; something is blocking the request. and i don't no what.... i close firewall + AV i don't see where and who block my call i don't get any message in the logs (not in the client and not in the server), except "...connection can not be...." i don't see any error in the console.log. When I run both app in my localhost - all work fine and i get CA digital Sign PDF File
  10. you right. sorry. PngGraphic := TPngGraphic.Create; try DibGraphic := TDibGraphic.Create; try Result := Base64ToImg(Base64Str, DibGraphic, FileExtn); if not Result then Exit; PngGraphic.Assign(DibGraphic); finally DibGraphic.Free; end; if PngGraphic.Empty then Exit; did you read the TAO? it's old as the wheel of time......
  11. Thanks Remy. no doubt your code is more efficient. but on save the base64 as PNG is not the right way. the base 64 is string depend on the file type. i work with Envision https://www.intervalsoftware.com/envision.html So i load any one of the type with appropriate object and convert it all to PNG, create the PNG, load it to the Html Files of the mail body and send the mail. You are the MASTER. UDDF - Tao of Programming.mht
  12. yeeee that abug yes. you right 🙂
  13. Ok. That Work. function Tdm_Image.DoFixMailTextBody(MAIL_TextBody : String; Attach_Base64 : TStringList) : String; Var CurTry : Integer; CurPos : Integer; CurChar : Integer; UniqueNo : Integer; StartFrom : Integer; EndTo : Integer; Base64Str : String; base64 : TBase64Encoding; StrArray : TBytes; DibGraphic : TDibGraphic; TmpPNG : TPngGraphic; TestStr : String; fTempDir : String; PngFileName : String; NewImgSrc : String; FileExtn : String; begin Result := MAIL_TextBody; Attach_Base64.Clear; CurTry := 0; While CurTry < 250 Do begin CurTry := CurTry + 1; FileExtn := ''; FileExtn := 'png'; CurPos := pos(Base64_01,MAIL_TextBody); if CurPos < 1 then begin FileExtn := 'jpg'; CurPos := pos(Base64_02,MAIL_TextBody); end; if CurPos < 1 then begin FileExtn := 'svg'; CurPos := pos(Base64_03,MAIL_TextBody); end; if CurPos < 1 then begin FileExtn := 'png'; CurPos := pos(Base64_04,MAIL_TextBody); end; if CurPos < 1 then begin FileExtn := 'jpg'; CurPos := pos(Base64_05,MAIL_TextBody); end; if CurPos < 1 then begin FileExtn := 'bmp'; CurPos := pos(Base64_06,MAIL_TextBody); end; if CurPos < 1 then begin FileExtn := 'gif'; CurPos := pos(Base64_07,MAIL_TextBody); end; if CurPos < 1 then begin FileExtn := 'tif'; CurPos := pos(Base64_08,MAIL_TextBody); end; if CurPos < 1 then begin FileExtn := 'wmf'; CurPos := pos(Base64_09,MAIL_TextBody); end; if CurPos < 1 then begin FileExtn := 'emf'; CurPos := pos(Base64_10,MAIL_TextBody); end; if CurPos > 0 then begin UniqueNo := GetUniqueNumber; {This will be tje dic Number} StartFrom := 0; EndTo := 0; // first find the , char - after that start the base64 string For CurChar := CurPos + 5 to Length(MAIL_TextBody) Do begin if MAIL_TextBody[CurChar] = ',' then begin StartFrom := CurChar + 1; Break; end; end; // the find the next " char - this close the base64 string For CurChar := StartFrom + 5 to Length(MAIL_TextBody) Do begin if MAIL_TextBody[CurChar] = '"' then begin EndTo := CurChar - 1; Break; end; end; // take the Base64 String And Convert to png file DibGraphic := TDibGraphic.Create; Try fTempDir := RemoveBackSlashChar(RemoveSlashChar(UniServerModule.LocalCachePath)); Base64Str := Copy(MAIL_TextBody,StartFrom, EndTo - StartFrom); if Base64ToImg(Base64Str,DibGraphic, FileExtn) then begin PngFileName := fTempDir + '\' + IntToStr(UniqueNo) + '.png'; TmpPNG := TPngGraphic.Create; Try TmpPNG.Assign(DibGraphic); TmpPNG.SaveToFile(PngFileName); Attach_Base64.Add(PngFileName); Delete(MAIL_TextBody, CurPos + 5, EndTo - CurPos - 4); NewImgSrc := 'cid:' + IntToStr(UniqueNo) +'.png'; Insert(NewImgSrc, MAIL_TextBody, CurPos + 5); Finally FreeAndNil(TmpPNG); End; end; Finally FreeAndNil(DibGraphic); End; end else begin Break; end; end; Result := MAIL_TextBody; end; and to send the Mail : function SendMailBySMTP(SMTP_Host : String; SMTP_User : String; SMTP_Password : String; SMTP_Port : Integer; Send_FromAddress : String; Send_FromName : String; Send_ToAddress : String; Send_ToName : String; Send_Subject : String; Send_TextBody : String; UseCid : Boolean; Attach_Base64 : TStringList; Attach_List : TStringList) : Boolean; Var cid : WideString; SMTP : TIdSMTP; AMsg : TidMessage; CurAttch : Integer; FoundBase64 : Boolean; Const Base64_01 : String = 'src="data:image/png;base64,'; Base64_02 : String = 'src="data:image/jpeg;base64,'; Base64_03 : String = 'src="data:image/image/svg+xml;base64,'; Base64_04 : String = 'src="data:image/image/apng;base64,'; Base64_05 : String = 'src="data:image/jpg;base64,'; Base64_06 : String = 'src="data:image/image/bmp;base64,'; Base64_07 : String = 'src="data:image/image/gif;base64,'; Base64_08 : String = 'src="data:image/image/tiff;base64,'; Base64_09 : String = 'src="data:image/image/wmf;base64,'; Base64_10 : String = 'src="data:image/image/emf;base64,'; begin Result := False; Try if UseCid Then begin FoundBase64 := False; if (pos(Base64_01,Send_TextBody) > 0) Or (pos(Base64_02,Send_TextBody) > 0) Or (pos(Base64_03,Send_TextBody) > 0) Or (pos(Base64_04,Send_TextBody) > 0) Or (pos(Base64_05,Send_TextBody) > 0) Or (pos(Base64_06,Send_TextBody) > 0) Or (pos(Base64_07,Send_TextBody) > 0) Or (pos(Base64_08,Send_TextBody) > 0) Or (pos(Base64_09,Send_TextBody) > 0) Or (pos(Base64_10,Send_TextBody) > 0) then FoundBase64 := True; if not FoundBase64 Then UseCid := False; end; if UseCid then begin end; Try SMTP:= TIdSMTP.Create(nil); SMTP.Disconnect(); SMTP.Host := SMTP_Host; SMTP.Username := SMTP_User; SMTP.Password := SMTP_Password; SMTP.Port := SMTP_Port; AMsg := TidMessage.Create(nil); AMsg.Encoding := meDefault; AMsg.ContentType := 'text/html'; if Attach_List.Count > 0 then AMsg.ContentType := 'multipart/mixed'; AMsg.CharSet := 'UTF-8'; //AMsg.ContentTransferEncoding := '8bit'; AMsg.subject := UTF8Encode(Send_Subject); AMsg.From.Name := UTF8Encode(Send_FromName); AMsg.From.Address := Send_FromAddress; with AMsg.Recipients.Add do begin Name := UTF8Encode(Send_ToName); Address := Send_ToAddress; end; with TIdMessageBuilderHtml.Create do try HtmlCharSet := 'UTF-8'; Html.Text := UTF8Encode(Send_TextBody); if Attach_List.Count > 0 then begin for CurAttch := 0 To Attach_List.Count - 1 Do begin Attachments.Add(Attach_List.Strings[CurAttch]); end; end; if Attach_Base64.Count > 0 then begin for CurAttch := 0 To Attach_Base64.Count - 1 Do begin HtmlFiles.Add(Attach_Base64.Strings[CurAttch]); end; end; FillMessage(AMsg); finally Free; end; SMTP.Connect; SMTP.Send(AMsg); Result := True; Finally AMsg.Free; SMTP.Disconnect; SMTP.Free; End; Except on E: Exception do begin AddMsgToEventLog('', J_FirstFileName(ParamStr(0)), 'Fail send SMPT Mail, Error :' + e.Message,EVENTLOG_ERROR_TYPE, 4, 1); Result := False; end; End; end; function IsTherBase64InHTML(HTML_Text : String) : Boolean; Const Base64_01 : String = 'src="data:image/png;base64,'; Base64_02 : String = 'src="data:image/jpeg;base64,'; Base64_03 : String = 'src="data:image/image/svg+xml;base64,'; Base64_04 : String = 'src="data:image/image/apng;base64,'; Base64_05 : String = 'src="data:image/jpg;base64,'; Base64_06 : String = 'src="data:image/image/bmp;base64,'; Base64_07 : String = 'src="data:image/image/gif;base64,'; Base64_08 : String = 'src="data:image/image/tiff;base64,'; Base64_09 : String = 'src="data:image/image/wmf;base64,'; Base64_10 : String = 'src="data:image/image/emf;base64,'; begin Result := (pos(Base64_01,HTML_Text) > 0) Or (pos(Base64_02,HTML_Text) > 0) Or (pos(Base64_03,HTML_Text) > 0) Or (pos(Base64_04,HTML_Text) > 0) Or (pos(Base64_05,HTML_Text) > 0) Or (pos(Base64_06,HTML_Text) > 0) Or (pos(Base64_07,HTML_Text) > 0) Or (pos(Base64_08,HTML_Text) > 0) Or (pos(Base64_09,HTML_Text) > 0) Or (pos(Base64_10,HTML_Text) > 0); end; thanks Remy for your Help.
×