From 630dbb00b682c2e5ebee6ec666694441230b29cf Mon Sep 17 00:00:00 2001
From: Hong-Dell\Hong <chlin1022@i-mps.com>
Date: 星期四, 04 七月 2024 15:22:55 +0800
Subject: [PATCH] Ver 2,0,1,80
---
CB_IMGPSScanImp.pas | 58 ++++++++++++++++++++++++++++++++++++++++------------------
1 files changed, 40 insertions(+), 18 deletions(-)
diff --git a/CB_IMGPSScanImp.pas b/CB_IMGPSScanImp.pas
index c1c3b45..88d347a 100644
--- a/CB_IMGPSScanImp.pas
+++ b/CB_IMGPSScanImp.pas
@@ -1,5 +1,5 @@
unit CB_IMGPSScanImp;
-//Test
+//TEST
{$WARN SYMBOL_PLATFORM OFF}
interface
@@ -24,7 +24,7 @@
Xmltool,inifiles,printers,IdHashMessageDigest, idHash, LogFile,ShellApi,
SBSocket,IIS_Ftp, SBSimpleFTPS;
Type
- TTransMode =(tsHttp,tsFtp);
+ TTransMode =(tsHttp,tsFtp,tsNone);
var
Ch_WriteNote : Boolean;
@@ -454,7 +454,8 @@
FFtpIP : String;
FFtpID : String;
FFtpPwd : String;
- FFtpPath : String;
+ FFtpRootPath : String;
+ FFtpExtraPath : String;
FFtpPort : Integer;
FFtpProtocol : TFtpProtocol;
//********Ftp參數*********
@@ -2803,7 +2804,7 @@
SaveStreamB:TFileStream;
cooom:integer;
Begin
- OpenDialog1.Filter := 'Image files|*.TIF;*.JPG';
+ OpenDialog1.Filter := 'Image files|*.TIF;*.JPG;*.PNG';
If OpenDialog1.Execute Then
Begin
ISB := TImageScrollBox.Create(self);
@@ -2998,16 +2999,19 @@
//ShowMessage(IntToStr(iGraphic.Palette.palNumEntries));
if iGraphic.ImageFormat = ifBlackWhite then //20200806 出現無法匯入,是因color256無法壓JPEG,待報會後再開啟
begin
+ SaveFilename := changefileext(SaveFilename,'.tif'); //20240320 Hong 調整黑白存tif
iGraphic.Compression:=tcGroup4;
end
else if iGraphic.ImageFormat= ifColor256 then
begin
+ SaveFilename := changefileext(SaveFilename,'.jpg'); //20240320 Hong 調整Color256存jpg
ConverttoGray(iGraphic);
iGraphic.Compression:=tcJPEG;
iGraphic.JpegQuality:=cooom;
end
else if (iGraphic.ImageFormat = ifTrueColor) or (iGraphic.ImageFormat = ifGray256) then
begin
+ SaveFilename := changefileext(SaveFilename,'.jpg'); //20240320 Hong 調整彩色灰階存jpg
iGraphic.Compression:=tcJPEG;
iGraphic.JpegQuality:=cooom;
end
@@ -3035,8 +3039,7 @@
SaveStream.Free;
End;
End
- Else If LowerCase(ExtractFileExt(SavePath + SaveFilename))
- = '.jpg' Then
+ Else If LowerCase(ExtractFileExt(SavePath + SaveFilename)) = '.jpg' Then
Begin
If FileExists(SavePath + SaveFilename) Then
DeleteFile(SavePath + SaveFilename);
@@ -3125,7 +3128,7 @@
JpgGr := TJpegGraphic.Create;
Try
JpgGr.Assign(iGraphic);
- JpgGr.SaveQuality := 30;
+ JpgGr.SaveQuality := cooom;
// JpgGr.AppendToStream(SaveStream);
JpgGr.SaveToFile(SavePath + SaveFilename);
Finally
@@ -4370,7 +4373,7 @@
SetFtpInfo;
IIS_Ftp.FtpsConnect;
- IIS_Ftp.FtpsToMain(FFtpPath,NowCaseno+'.pdf','d:\1.pdf',display1);
+ IIS_Ftp.FtpsToMain(FFtpExtraPath,NowCaseno+'.pdf','d:\1.pdf',display1);
end;
procedure TCB_IMGPSScanX.Button6Click(Sender: TObject);
@@ -6640,6 +6643,7 @@
+'&must_formid='+must_formidStr //擁有的 formid
+'&last_add_formid='+last_add_formidstr //當次新加的 formid
+'&form_code='+ScanListStr //scanlist.dat 表單代號
+ +'&ftp_image_path='+FFtpExtraPath //加傳FTP目錄 HTTP上傳時會是空白
+'&in_doc1='+HTTPEncode(UTF8Encode(In_Doc1))
+'&in_doc2='+HTTPEncode(UTF8Encode(In_Doc2));
@@ -6681,7 +6685,7 @@
Result := False;
Exit;
end;
- if not IIS_Ftp.FtpsToMain(FFtpPath,CaseID+'.zip',Path+'Img.zip',display1) then
+ if not IIS_Ftp.FtpsToMain(FFtpExtraPath,CaseID+'.zip',Path+'Img.zip',display1) then
begin
Showmessage(Format(_msg('上傳案件(%s)時,發生錯誤,錯誤原因:%s'),[CaseID,FtpErrStr]));
Result := False;
@@ -6930,7 +6934,7 @@
Function TCB_IMGPSScanX.DownLoadImage(Path,CaseID:String):Boolean;
begin
Result := True;
- if not GetftpInfo(CaseID,'download') then //取案件上傳方式
+ if not GetftpInfo(CaseID,'download') then //取案件下載方式
begin
DownFileErrStr := _Msg('取案件下載資訊失敗,')+HttpErrStr;
Result := False;
@@ -6960,7 +6964,7 @@
Result := False;
Exit;
end;
- if not IIS_Ftp.FtpsDownloadFile(IIS_Ftp.FtpPath,CaseID+'.zip',Path+CaseID+'.zip',display1) then
+ if not IIS_Ftp.FtpsDownloadFile(FFtpExtraPath,CaseID+'.zip',Path+CaseID+'.zip',display1) then
begin
DownFileErrStr := Format(_Msg('錯誤原因:%s'),[FtpErrStr]);
Result := False;
@@ -10993,26 +10997,43 @@
Result := False;
Exit;
end;
- IF (memo1.Lines.Strings[0] = '1') or (memo1.Lines.Strings[0] <> '0') Then
+ IF (memo1.Lines.Strings[0] = '1') Then
begin
- HttpErrStr := _Msg('錯誤原因:')+memo1.Lines.Strings[1];
- Result := False;
- Exit;
+ if memo1.Lines.Strings[1]='nodata' then //nodata 為正常可繼續的判斷
+ begin
+ TransMode := tsNone;
+ Result := True;
+ Exit;
+ end
+ else
+ begin
+ HttpErrStr := _Msg('錯誤原因:')+memo1.Lines.Strings[1];
+ Result := False;
+ Exit;
+ end;
end
Else if Pos('<script type="text/javascript" src="scripts/CW00/login.js"></script>',Memo1.Lines.Text) > 0 then
begin
HttpErrStr := _Msg('錯誤原因:')+_Msg('閒置過久或被登出,請重新登入');
Result := False;
Exit;
+ end
+ else if (memo1.Lines.Strings[0] <> '0') then//不認識的字串
+ begin
+ HttpErrStr := _Msg('錯誤原因:')+memo1.Lines.Strings[0];
+ Result := False;
+ Exit;
end;
TransMode := tsHttp;
+ FFtpExtraPath := '';
+
if memo1.Lines.Strings[0] = '0' then
begin
- if memo1.Lines.Strings[2] = 'Y' then
+ if memo1.Lines.Strings[2] = 'Y' then //要使用FTP
TransMode := tsFtp;
if memo1.Lines.Count > 3 then
begin
- FFtpPath := memo1.Lines.Strings[3];
+ FFtpExtraPath := memo1.Lines.Strings[3];
DecodeFtpInfo(memo1.Lines.Strings[4]);
end;
end;
@@ -11027,7 +11048,7 @@
IIS_Ftp.Ftpip := FFtpIP;
IIS_Ftp.Ftpuserid := FFtpID;
IIS_Ftp.FtpPwd := FFtpPwd;
- IIS_Ftp.FtpPath := FFtpPath;
+ IIS_Ftp.FtpPath := FFtpRootPath;
IIS_Ftp.FtpPort := FFtpPort;
IIS_Ftp.FtpSSL := True;
IIS_Ftp.FtpPassive := True;
@@ -14896,6 +14917,7 @@
FMaxUploadSize:='10';
FJpgCompression:=50;
+ FFtpRootPath := ''; //影像平台沒有給FtpRoot目錄,會直接用FFtpExtraPath切換至指定目錄
//FMode := 'DSCAN' ;
//FIs_In_Wh := 'Y';
if FIs_In_Wh = 'Y' then
--
Gitblit v1.8.0