From f577443b19a16ee59a8ac5cc8f4745c09108d3e2 Mon Sep 17 00:00:00 2001
From: Hong-Dell\Hong <chlin1022@i-mps.com>
Date: 星期四, 14 三月 2024 17:56:53 +0800
Subject: [PATCH] Ver 2,0,1,78
---
CB_IMGPSScanImp.dfm | 66 ++++++
ErrList.dcu | 0
CB_IMGPSScan.ocx | 0
ErrList.pas | 51 ++++-
CB_IMGPSScan.dproj | 4
CB_IMGPSScan.res | 0
CB_IMGPSScan_test.dproj | 4
ErrList.dfm | 8
OldCaseInfo.dcu | 0
CB_IMGPSScanImp.dcu | 0
CB_IMGPSScan_test.res | 0
CB_IMGPSScanImp.pas | 360 ++++++++++++++++++++++++++++++++++-----
CB_IMGPSScan_test.ocx | 0
13 files changed, 428 insertions(+), 65 deletions(-)
diff --git a/CB_IMGPSScan.dproj b/CB_IMGPSScan.dproj
index a29a32d..73a09cc 100644
--- a/CB_IMGPSScan.dproj
+++ b/CB_IMGPSScan.dproj
@@ -96,7 +96,7 @@
<VersionInfo Name="MajorVer">2</VersionInfo>
<VersionInfo Name="MinorVer">0</VersionInfo>
<VersionInfo Name="Release">1</VersionInfo>
- <VersionInfo Name="Build">77</VersionInfo>
+ <VersionInfo Name="Build">78</VersionInfo>
<VersionInfo Name="Debug">False</VersionInfo>
<VersionInfo Name="PreRelease">False</VersionInfo>
<VersionInfo Name="Special">False</VersionInfo>
@@ -108,7 +108,7 @@
<VersionInfoKeys>
<VersionInfoKeys Name="CompanyName"/>
<VersionInfoKeys Name="FileDescription"/>
- <VersionInfoKeys Name="FileVersion">2.0.1.77</VersionInfoKeys>
+ <VersionInfoKeys Name="FileVersion">2.0.1.78</VersionInfoKeys>
<VersionInfoKeys Name="InternalName"/>
<VersionInfoKeys Name="LegalCopyright"/>
<VersionInfoKeys Name="LegalTrademarks"/>
diff --git a/CB_IMGPSScan.ocx b/CB_IMGPSScan.ocx
index 1b25b72..7734a0a 100644
--- a/CB_IMGPSScan.ocx
+++ b/CB_IMGPSScan.ocx
Binary files differ
diff --git a/CB_IMGPSScan.res b/CB_IMGPSScan.res
index 705996e..c6a0213 100644
--- a/CB_IMGPSScan.res
+++ b/CB_IMGPSScan.res
Binary files differ
diff --git a/CB_IMGPSScanImp.dcu b/CB_IMGPSScanImp.dcu
index 0722971..662d103 100644
--- a/CB_IMGPSScanImp.dcu
+++ b/CB_IMGPSScanImp.dcu
Binary files differ
diff --git a/CB_IMGPSScanImp.dfm b/CB_IMGPSScanImp.dfm
index 7c3e436..618344f 100644
--- a/CB_IMGPSScanImp.dfm
+++ b/CB_IMGPSScanImp.dfm
@@ -987,6 +987,26 @@
Visible = False
OnClick = Button4Click
end
+ object Button5: TButton
+ Left = 891
+ Top = 8
+ Width = 75
+ Height = 25
+ Caption = 'Button5'
+ TabOrder = 5
+ Visible = False
+ OnClick = Button5Click
+ end
+ object Button6: TButton
+ Left = 921
+ Top = 32
+ Width = 75
+ Height = 25
+ Caption = 'Button6'
+ TabOrder = 6
+ Visible = False
+ OnClick = Button6Click
+ end
end
object Panel4: TPanel
Left = 0
@@ -5798,7 +5818,7 @@
Left = 32
Top = 360
Bitmap = {
- 494C01010A000D001C0010001000FFFFFFFFFF10FFFFFFFFFFFFFFFF424D3600
+ 494C01010A000D00540010001000FFFFFFFFFF10FFFFFFFFFFFFFFFF424D3600
0000000000003600000028000000400000003000000001002000000000000030
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
@@ -6207,7 +6227,7 @@
Left = 32
Top = 225
Bitmap = {
- 494C0101050009001C0020002000FFFFFFFFFF10FFFFFFFFFFFFFFFF424D3600
+ 494C010105000900540020002000FFFFFFFFFF10FFFFFFFFFFFFFFFF424D3600
0000000000003600000028000000800000004000000001002000000000000080
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
@@ -7278,7 +7298,7 @@
Left = 29
Top = 273
Bitmap = {
- 494C0101070009001C0020002000FFFFFF00FF10FFFFFFFFFFFFFFFF424D3600
+ 494C010107000900540020002000FFFFFF00FF10FFFFFFFFFFFFFFFF424D3600
0000000000003600000028000000800000004000000001002000000000000080
000000000000000000000000000000000000FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
@@ -8349,7 +8369,7 @@
Left = 37
Top = 313
Bitmap = {
- 494C0101070009001C0020002000FFFFFF00FF10FFFFFFFFFFFFFFFF424D3600
+ 494C010107000900540020002000FFFFFF00FF10FFFFFFFFFFFFFFFF424D3600
0000000000003600000028000000800000004000000001002000000000000080
000000000000000000000000000000000000FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
@@ -9722,4 +9742,42 @@
Left = 464
Top = 368
end
+ object FTPSClient1: TElSimpleFTPSClient
+ AuthCmd = acAuto
+ ModeZLevel = 8
+ Versions = [sbSSL2, sbSSL3, sbTLS1, sbTLS11, sbTLS12]
+ EncryptDataChannel = False
+ FTPBufferSize = 262144
+ ProxySettings.Port = 0
+ ProxySettings.ProxyType = ptNone
+ CommandSocketBinding.Port = 0
+ CommandSocketBinding.ReuseAddress = False
+ CommandSocketBinding.PortRangeFrom = 0
+ CommandSocketBinding.PortRangeTo = 0
+ DataSocketBinding.Port = 0
+ DataSocketBinding.ReuseAddress = False
+ DataSocketBinding.PortRangeFrom = 0
+ DataSocketBinding.PortRangeTo = 0
+ UseSIZECmd = True
+ UseFEATCmd = True
+ AdjustPasvAddress = True
+ RenegotiationAttackPreventionMode = rapmCompatible
+ IncomingSpeedLimit = 0
+ OutgoingSpeedLimit = 0
+ ConcurrentConnections = 1
+ MinSizeForConcurrentDownload = 5242880
+ Options = []
+ SSLOptions = [ssloAutoAddServerNameExtension]
+ QuoteParameters = pqmNone
+ QuoteParamChar = '"'
+ SocksAuthentication = saNoAuthentication
+ WebTunnelPort = 3128
+ UseProxySettingsForDataChannel = False
+ PreserveExistingFileTimes = False
+ CopyEmptyDirs = True
+ DeleteFailedDownloads = False
+ OperationErrorHandling = oehTryAllItems
+ Left = 432
+ Top = 472
+ end
end
diff --git a/CB_IMGPSScanImp.pas b/CB_IMGPSScanImp.pas
index 2568e1a..c1c3b45 100644
--- a/CB_IMGPSScanImp.pas
+++ b/CB_IMGPSScanImp.pas
@@ -22,7 +22,9 @@
Buttons, ImgList, SBSimpleSSL, SBHTTPSClient, SBWinCertStorage, SBX509,
SBCustomCertStorage, SBUtils,mpsBarco,BarcodesFinder,HTTPApp,ErrList,
Xmltool,inifiles,printers,IdHashMessageDigest, idHash, LogFile,ShellApi,
- SBSocket;
+ SBSocket,IIS_Ftp, SBSimpleFTPS;
+Type
+ TTransMode =(tsHttp,tsFtp);
var
Ch_WriteNote : Boolean;
@@ -273,6 +275,9 @@
PrtLb: TLabel;
CaseHelpBtn: TBitBtn;
HTTPSClient: TElHTTPSClient;
+ Button5: TButton;
+ FTPSClient1: TElSimpleFTPSClient;
+ Button6: TButton;
procedure ActiveFormCreate(Sender: TObject);
procedure Panel9Resize(Sender: TObject);
procedure ISB1Click(Sender: TObject);
@@ -399,6 +404,8 @@
Shift: TShiftState; X, Y: Integer);
procedure HTTPSClientRedirection(Sender: TObject; const OldURL: string;
var NewURL: string; var AllowRedirection: Boolean);
+ procedure Button5Click(Sender: TObject);
+ procedure Button6Click(Sender: TObject);
private
{ Private declarations }
HotKeyId1,HotKeyId2,HotKeyId3,HotKeyId4 :Integer;
@@ -438,9 +445,19 @@
FWH_category:string; //Y/N Y是歸類時有區分入庫非入庫文件 N 是不區分
////////傳入參數///////
+ TransMode : TTransMode; //用何種方式上傳檔案
//********Http參數********
HttpErrStr : String; //錯誤訊息
//********Http參數********
+
+ //********Ftp參數*********
+ FFtpIP : String;
+ FFtpID : String;
+ FFtpPwd : String;
+ FFtpPath : String;
+ FFtpPort : Integer;
+ FFtpProtocol : TFtpProtocol;
+ //********Ftp參數*********
//********ini參數********
DeviceDelete : Boolean; //空白頁刪除啟動
@@ -548,6 +565,7 @@
DocNoLength : Integer; //Docno長度
PEFileName : String; //掃描時的檔名
+ DownFileErrStr : String; //下載影像時發生的錯誤
ISB : TImageScrollBox;
ScanInfo : TScanInfo;
@@ -611,6 +629,11 @@
Function GetFindResult(Col:String):String;
//*********SQL相關************
+ //*********FTP相關************
+ Function GetFtpinfo(CaseID,Action:String):Boolean;
+ Procedure SetFtpInfo; //餵入FTP資訊
+ Function FtpCaseComplete(SendData:String):Boolean;
+ //*********FTP相關************
//*******轉換區*********
Function FindDivFormCode(FormCode:String):Boolean; //找有沒有分案的條碼
@@ -727,6 +750,7 @@
Function Node3FormID(Node3:TTreeNode):String; //MyTreeNode3取FormCode出來
Function GetNode2Name(Node2:TTreeNode):String; //取MyTreeNode2的識別字出來(記之前點選用)
//Function Down_Replace_Img(SPAth,DPath,CaseID:String):Boolean;
+ Function DownLoadImage(Path,CaseID:String):Boolean;
Function Down_Img(Path,CaseID:String):Boolean;
Function GetNoNameCase(Path:string):String; //取未配號XXXX
Procedure CaseResort(Path:String); //案件的檔案重新排序(次文件依Docno挑)
@@ -4340,6 +4364,26 @@
// SampleFormIDList.Add('31A00101031706A');
end;
+procedure TCB_IMGPSScanX.Button5Click(Sender: TObject);
+begin
+ GetftpInfo(NowCaseno,'upload');
+ SetFtpInfo;
+ IIS_Ftp.FtpsConnect;
+
+ IIS_Ftp.FtpsToMain(FFtpPath,NowCaseno+'.pdf','d:\1.pdf',display1);
+end;
+
+procedure TCB_IMGPSScanX.Button6Click(Sender: TObject);
+begin
+ GetftpInfo(NowCaseno,'download');
+ SetFtpInfo;
+ IIS_Ftp.FtpsConnect;
+ IIS_Ftp.FtpsCWD(IIS_Ftp.FtpPath);
+ IIS_Ftp.FtpsReceive(NowCaseNo+'.zip','d:\'+NowCaseNo+'.zip');
+
+
+end;
+
procedure TCB_IMGPSScanX.StatrTwainScan;
var ScanInfo : TScanInfo;
i : Integer;
@@ -6422,10 +6466,11 @@
In_Doc1,In_Doc2 : String;
AttachYN : String; //是否有附件 Y:有 N:沒有
- ST1,ST2:TStringList;
+ ST1,ST2,ST3:TStringList;
str1,str2:String;
must_formidStr :string;
last_add_formidstr :string;
+ ScanListStr:String;
casepath:String;
filesizeInt:integer;
case_page:string;
@@ -6463,20 +6508,12 @@
//CaseResort(Path); //檔名照設定排序
CreateFormID_FormName(Path,CaseID); //產生FormID_FormName.dat
CreateDocNo_DocName(Path,CaseID); //產生DocNo_Name.dat
-//ShowMessage('EEEEEEEEEE');
Doc_Data := CreateDocNo_Info(CaseID); //產生保管袋文件 Docno,份數,頁數;Docno,份數,頁數 的回傳字串
-//ShowMessage('1111111111');
Doc_Data1 := CreateCustDocNo_Info(CaseID); //產生自定文件 Docname,份數,頁數;Docno,份數,頁數 的回傳字串
-//ShowMessage('2222222222');
In_Doc1 := CreateDocnoFrom_Info(CaseID); //產生被引進的保管袋文件資訊 Docno[tab]份數[tab]案件編號#13#10Docno[tab]份數[tab]案件編號
-//ShowMessage('333333333333333333');
In_Doc2 := CreateCustDocNoFrom_Info(CaseID); //產生被引進的自定文件資訊 Docno[tab]份數[tab]案件編號#13#10Docno[tab]份數[tab]案件編號
-//ShowMessage('4444444444444');
AttachYN := CreateAttach_Info(CaseID); //是否還有附件 Y:有 N:沒有
- //self.ReadCaseIndex()
-//ShowMessage('555555555555');
ReadCaseIndex(Path);
-//ShowMessage('DDDDDDDDDD');
//LoanDoc := 'Y';
//產生遮罩影像
// if FWork_No = 'CW' then
@@ -6492,6 +6529,7 @@
//ShowMessage(ST1.Text);
//ShowMessage(LastInitFormidList.Text);
ST2:=TStringList.Create;
+ ST3:=TStringlist.Create;
for I := 0 to ST1.Count - 1 do
begin
@@ -6505,6 +6543,8 @@
must_formidStr:=Copy(must_formidStr,1,Length(must_formidStr)-3) ;
//ShowMessage('must_formidStr='+must_formidStr);
//ShowMessage('AST2='+ST2.Text);
+
+
for I := 0 to LastInitFormidList.Count - 1 do
begin
if ST2.IndexOf(LastInitFormidList.Strings[i]) <> -1 then
@@ -6518,8 +6558,19 @@
last_add_formidstr:=last_add_formidstr+ST2.Strings[i]+'@#,';
end;
last_add_formidstr:=Copy(last_add_formidstr,1,Length(last_add_formidstr)-3) ;
+
+ ST3.LoadFromFile(path+'scanlist.dat');
+ for I := 0 to ST3.Count - 1 do
+ begin
+ if ScanListStr = '' then
+ ScanListStr := FileName2FormCode(ST3.Strings[i])
+ else
+ ScanListStr := Format('%s,%s',[ScanListStr,FileName2FormCode(ST3.Strings[i])]);
+ end;
+
ST1.Free;
ST2.Free;
+ ST3.Free;
//ShowMessage('last_add_formidstr='+last_add_formidstr);
///////必要formid 20170315 end //////////////////////////
@@ -6569,44 +6620,88 @@
FindClose(FileRec);
///檢查上傳的zip大小////
//ShowMessage('last_add_formidstr='+last_add_formidstr);
- ////上傳/////
+ if not GetftpInfo(CaseID,'upload') then //取案件上傳方式
+ begin
+ //Showmessage(_Msg()Inttostr(HttpError.HttpErrorCode)+' '+HttpError.HttpReason+'.');
+ DownFileErrStr := _Msg('取案件上傳資訊失敗!!')+HttpErrStr;
+ Result := False;
+ Exit;
+ end;
SendData:='data='+HTTPEncode(UTF8Encode(FData))
- +'&verify='+FVerify
- +'&form_id='+UpformID
- +'&loan_doc='+Case_loandoc
- +'&case_no='+TransName
- +'&doc_data='+HTTPEncode(UTF8Encode(Doc_Data))
- +'&doc_data1='+HTTPEncode(UTF8Encode(Doc_Data1))
- +'&attach='+AttachYN
- +'&case_page='+case_page
- +'&file_size='+IntToStr(filesizeInt)
- +'&must_formid='+must_formidStr //擁有的 formid
- +'&last_add_formid='+last_add_formidstr //當次新加的 formid
- +'&in_doc1='+HTTPEncode(UTF8Encode(In_Doc1))
- +'&in_doc2='+HTTPEncode(UTF8Encode(In_Doc2));
-//ShowMessage('SendData='+SendData);
-//ShowMessage(FData+#10#13+Doc_Data);
- //Showmessage('Wait');
+ +'&verify='+FVerify
+ +'&form_id='+UpformID
+ +'&loan_doc='+Case_loandoc
+ +'&case_no='+TransName
+ +'&doc_data='+HTTPEncode(UTF8Encode(Doc_Data))
+ +'&doc_data1='+HTTPEncode(UTF8Encode(Doc_Data1))
+ +'&attach='+AttachYN
+ +'&case_page='+case_page
+ +'&file_size='+IntToStr(filesizeInt)
+ +'&must_formid='+must_formidStr //擁有的 formid
+ +'&last_add_formid='+last_add_formidstr //當次新加的 formid
+ +'&form_code='+ScanListStr //scanlist.dat 表單代號
+ +'&in_doc1='+HTTPEncode(UTF8Encode(In_Doc1))
+ +'&in_doc2='+HTTPEncode(UTF8Encode(In_Doc2));
- if not upFile(HTTPSClient,FUrl,'service/imgpsc/IMGPSC02/caseupload',SendData,'file',Path+'Img.zip',FReWrite,Memo1,False) then
- begin
- Showmessage(Inttostr(HttpError.HttpErrorCode)+' '+HttpError.HttpReason+'.');
- Result := False;
- Exit;
+ case TransMode of
+ tsHttp :
+ begin
+ ////上傳/////
+ ShowText := CaseID+_Msg('資料上傳中(Http),請稍候');
+ DataLoading(True,True);
+ if not upFile(HTTPSClient,FUrl,'service/imgpsc/IMGPSC02/caseupload',SendData,'file',Path+'Img.zip',FReWrite,Memo1,False) then
+ begin
+ Showmessage(Inttostr(HttpError.HttpErrorCode)+' '+HttpError.HttpReason+'.');
+ Result := False;
+ Exit;
+ end;
+ if memo1.Lines.Strings[0] = '1' then
+ begin
+ Showmessage(Format(_Msg('')+_Msg(''),[CaseID])+memo1.Lines.Strings[1]+'。');
+ Result := False;
+ Exit;
+ end
+ Else if Pos('<script type="text/javascript" src="scripts/IMGPS00/login.js"></script>',Memo1.Lines.Text) > 0 then
+ begin
+ Showmessage(Format(_Msg('')+_Msg('')+_Msg('閒置過久或被登出,請重新登入'),[CaseID]));
+ Result := False;
+ Exit;
+ end;
+ ////上傳////
+ end;
+ tsFtp :
+ begin
+ ShowText := CaseID+_Msg('資料上傳中(Ftp),請稍候');
+ DataLoading(True,True);
+ SetFtpInfo;
+ try
+ if not IIS_Ftp.FtpsConnect then
+ begin
+ Showmessage(Format('無法連上Ftp主機,錯誤原因:%s',[FtpErrReason]));
+ Result := False;
+ Exit;
+ end;
+ if not IIS_Ftp.FtpsToMain(FFtpPath,CaseID+'.zip',Path+'Img.zip',display1) then
+ begin
+ Showmessage(Format(_msg('上傳案件(%s)時,發生錯誤,錯誤原因:%s'),[CaseID,FtpErrStr]));
+ Result := False;
+ Exit;
+ end;
+
+ if not FtpCaseComplete(SendData) then //Ftp上傳後通知完成
+ begin
+ Showmessage(Format(_Msg('通知案件(%s)Ftp上傳完成時,發生錯誤!!'),[CaseID])+HttpErrStr);
+ Result := False;
+ Exit;
+ end;
+ finally
+ IIS_Ftp.FtpsClose;
+ end;
+ end;
+
end;
- if memo1.Lines.Strings[0] = '1' then
- begin
- Showmessage(Format(_Msg('')+_Msg(''),[CaseID])+memo1.Lines.Strings[1]+'。');
- Result := False;
- Exit;
- end
- Else if Pos('<script type="text/javascript" src="scripts/IMGPS00/login.js"></script>',Memo1.Lines.Text) > 0 then
- begin
- Showmessage(Format(_Msg('')+_Msg('')+_Msg('閒置過久或被登出,請重新登入'),[CaseID]));
- Result := False;
- Exit;
- end;
- ////上傳////
+
+
if FMode = 'ESCAN' then //上傳舊件引入檔案 //20140616 原本先搬舊件再搬新件,改為先搬新件再搬舊件
begin
if not TransOldCaseFile(ImageSavePath+CaseID+'\') then
@@ -6831,6 +6926,52 @@
if DirectoryExists(SPath+'AttFile\') then
AttFile_Arrange(SPath+'AttFile\',DPath+'AttFile\');
end;}
+
+Function TCB_IMGPSScanX.DownLoadImage(Path,CaseID:String):Boolean;
+begin
+ Result := True;
+ if not GetftpInfo(CaseID,'download') then //取案件上傳方式
+ begin
+ DownFileErrStr := _Msg('取案件下載資訊失敗,')+HttpErrStr;
+ Result := False;
+ Exit;
+ end;
+ case TransMode of
+ tsHttp:
+ begin
+ ShowText := _Msg('案件下載中(Http),請稍候');
+ DataLoading(True,True);
+ If not Down_Img(ImageSavePath+FCaseID+'\Download\',FCaseID) then
+ begin
+ Showmessage(FCaseID+_msg('載入異動影像時,網路發生錯誤')+HttpErrStr);
+ DataLoading(False,False);
+ Exit;
+ end;
+ end;
+ tsFtp:
+ begin
+ ShowText := _Msg('案件下載中(Ftp),請稍候');
+ DataLoading(True,True);
+ SetFtpInfo;
+
+ if not IIS_Ftp.FtpsConnect then
+ begin
+ DownFileErrStr := Format(_Msg('無法連上Ftp主機,錯誤原因:%s')+#13+'%s',[FtpErrReason,FTPSClient1.LastReceivedReply]);
+ Result := False;
+ Exit;
+ end;
+ if not IIS_Ftp.FtpsDownloadFile(IIS_Ftp.FtpPath,CaseID+'.zip',Path+CaseID+'.zip',display1) then
+ begin
+ DownFileErrStr := Format(_Msg('錯誤原因:%s'),[FtpErrStr]);
+ Result := False;
+ Exit;
+ end;
+ ExecuteUnZip(Path+CaseID+'.zip',Path,False);
+ DeleteFile(Path+CaseID+'.zip');
+ end;
+ end;
+end;
+
Function TCB_IMGPSScanX.Down_Img(Path,CaseID:String):Boolean;
var
@@ -8671,7 +8812,6 @@
if Col =RCol then
Result := RValue;
end;
-
end;
Procedure TCB_IMGPSScanX.DataLoading(Loading:Boolean;UseTimer:Boolean); //資料載入中要停止點選的動作
@@ -10804,6 +10944,120 @@
Exit;
end;
IF memo1.Lines.Strings[0] = '1' Then
+ begin
+ HttpErrStr := _Msg('錯誤原因:')+memo1.Lines.Strings[1];
+ Result := False;
+ Exit;
+ 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;
+end;
+
+Function TCB_IMGPSScanX.GetFtpinfo(CaseID,Action:String):Boolean;
+var
+ SendData : String;
+
+ Procedure DecodeFtpInfo(EncryStr:String);
+ var
+ FtpStr : String;
+ ftpinfoList : TStringlist;
+ begin
+ if EncryStr = '' then Exit;
+ ftpinfoList := TStringlist.Create;
+ try
+ FtpStr := En_DecryptionStr_Base64('D',EncryStr,MpsKey);
+ SplitString('!@!',FtpStr,ftpinfoList);
+ if ftpinfoList[0] = 'ftps' then
+ FFtpProtocol := fpftps
+ else if ftpinfoList[0] = 'ftp' then
+ FFtpProtocol := fpftp;
+ FFtpIP := ftpinfoList[1];
+ FFtpPort := strtoint(ftpinfoList[2]);
+ FFtpID := ftpinfoList[3];
+ FFtpPwd := ftpinfoList[4];
+
+ finally
+ ftpinfoList.Free;
+ end;
+ end;
+begin
+ Result := True;
+ SendData:='product='+FWork_no+'&case_no='+CaseID+'&department='+FUserUnit+'&action='+Action;
+ If not ProcessServlet_FormData(HTTPSClient,FURL+'service/imgpsc/IMGPSC02/ftps',SendData,FReWrite,Memo1,False) Then
+ begin
+ HttpErrStr := _Msg('錯誤代碼:')+inttostr(HttpError.HttpErrorCode)+','+HttpError.HttpReason;
+ Result := False;
+ Exit;
+ end;
+ IF (memo1.Lines.Strings[0] = '1') or (memo1.Lines.Strings[0] <> '0') Then
+ begin
+ HttpErrStr := _Msg('錯誤原因:')+memo1.Lines.Strings[1];
+ Result := False;
+ Exit;
+ 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;
+ TransMode := tsHttp;
+ if memo1.Lines.Strings[0] = '0' then
+ begin
+ if memo1.Lines.Strings[2] = 'Y' then
+ TransMode := tsFtp;
+ if memo1.Lines.Count > 3 then
+ begin
+ FFtpPath := memo1.Lines.Strings[3];
+ DecodeFtpInfo(memo1.Lines.Strings[4]);
+ end;
+ end;
+end;
+
+Procedure TCB_IMGPSScanX.SetFtpInfo; //餵入FTP資訊
+begin
+ IIS_Ftp.Display1 := Display1;
+ IIS_Ftp.FTPSClient1 := FTPSClient1;
+ IIS_Ftp.ElMemoryCertStorage := ElMemoryCertStorage;
+ IIS_Ftp.Display1 := Display1;
+ IIS_Ftp.Ftpip := FFtpIP;
+ IIS_Ftp.Ftpuserid := FFtpID;
+ IIS_Ftp.FtpPwd := FFtpPwd;
+ IIS_Ftp.FtpPath := FFtpPath;
+ IIS_Ftp.FtpPort := FFtpPort;
+ IIS_Ftp.FtpSSL := True;
+ IIS_Ftp.FtpPassive := True;
+ if FFtpProtocol = fpftp then
+ IIS_Ftp.FtpSSL := False;
+ IIS_Ftp.FtpEncryptDataChannel := true;
+ FTPSClient1.OnControlReceiveAsString := IIS_Ftp.EventHandlers.ControlReceiveAsString;
+ FTPSClient1.OnControlSendAsString := IIS_Ftp.EventHandlers.ControlSendAsString;
+ FTPSClient1.OnSSLError := IIS_Ftp.EventHandlers.SSLError;
+ FTPSClient1.OnCertificateValidate := IIS_Ftp.EventHandlers.CertificateValidate;
+ FTPSClient1.OnTextDataLine := IIS_Ftp.EventHandlers.TextDataLine;
+
+ {Showmessage(Format('Ftpip:%s'+#13
+ +'Ftpid:%s'+#13
+ +'Ftppwd:%s'+#13
+ +'Ftppath:%s'+#13
+ +'Ftpport:%s'+#13
+ ,[FFtpIP,FFtpid,FFtpPwd,Ftppath,inttostr(Ftpport)]));}
+end;
+
+Function TCB_IMGPSScanX.FtpCaseComplete(SendData:String):Boolean;
+begin
+ Result := True;
+ If not ProcessServlet_FormData(HTTPSClient,FURL+'service/imgpsc/IMGPSC02/caseupload',SendData,FReWrite,Memo1,False) Then
+ begin
+ HttpErrStr := _Msg('錯誤代碼:')+inttostr(HttpError.HttpErrorCode)+','+HttpError.HttpReason;
+ Result := False;
+ Exit;
+ end;
+ IF (memo1.Lines.Strings[0] = '1') or (memo1.Lines.Strings[0] <> '0') Then
begin
HttpErrStr := _Msg('錯誤原因:')+memo1.Lines.Strings[1];
Result := False;
@@ -14934,12 +15188,19 @@
begin
ShowText := _Msg('案件下載中,請稍候');
DataLoading(True,True);
- If not Down_Img(ImageSavePath+FCaseID+'\Download\',FCaseID) then
+ If not DownLoadImage(ImageSavePath+FCaseID+'\Download\',FCaseID) Then
+ begin
+ Showmessage(FCaseID+_msg('載入異動影像時,網路發生錯誤')+DownFileErrStr);
+ DataLoading(False,False);
+ Exit;
+ end;
+
+ {If not Down_Img(ImageSavePath+FCaseID+'\Download\',FCaseID) then
begin
Showmessage(FCaseID+_msg('載入異動影像時,網路發生錯誤')+HttpErrStr);
DataLoading(False,False);
Exit;
- end;
+ end;}
//Showmessage(ImageSavePath+FCaseID+'\Download\'+#10#13+ImageSavePath+FCaseID+'\');
Download2Case(ImageSavePath+FCaseID+'\Download\',ImageSavePath+FCaseID+'\');
//Showmessage('aaa');
@@ -15145,6 +15406,9 @@
begin
/////訊問是否可上傳/////
CaseTrans := CaseAsk(CaseID);
+ //Showmessage('記得改回來');
+ //CaseTrans := 0;
+
/////訊問是否可上傳////
end
Else ///不是新件、重掃件、異動件的不查
diff --git a/CB_IMGPSScan_test.dproj b/CB_IMGPSScan_test.dproj
index 2dd9887..680e1af 100644
--- a/CB_IMGPSScan_test.dproj
+++ b/CB_IMGPSScan_test.dproj
@@ -96,7 +96,7 @@
<VersionInfo Name="MajorVer">2</VersionInfo>
<VersionInfo Name="MinorVer">0</VersionInfo>
<VersionInfo Name="Release">1</VersionInfo>
- <VersionInfo Name="Build">77</VersionInfo>
+ <VersionInfo Name="Build">78</VersionInfo>
<VersionInfo Name="Debug">False</VersionInfo>
<VersionInfo Name="PreRelease">False</VersionInfo>
<VersionInfo Name="Special">False</VersionInfo>
@@ -108,7 +108,7 @@
<VersionInfoKeys>
<VersionInfoKeys Name="CompanyName"/>
<VersionInfoKeys Name="FileDescription"/>
- <VersionInfoKeys Name="FileVersion">2.0.1.77</VersionInfoKeys>
+ <VersionInfoKeys Name="FileVersion">2.0.1.78</VersionInfoKeys>
<VersionInfoKeys Name="InternalName"/>
<VersionInfoKeys Name="LegalCopyright"/>
<VersionInfoKeys Name="LegalTrademarks"/>
diff --git a/CB_IMGPSScan_test.ocx b/CB_IMGPSScan_test.ocx
index fff3846..0d5f9b6 100644
--- a/CB_IMGPSScan_test.ocx
+++ b/CB_IMGPSScan_test.ocx
Binary files differ
diff --git a/CB_IMGPSScan_test.res b/CB_IMGPSScan_test.res
index 705996e..c6a0213 100644
--- a/CB_IMGPSScan_test.res
+++ b/CB_IMGPSScan_test.res
Binary files differ
diff --git a/ErrList.dcu b/ErrList.dcu
index 940e48b..cfd0149 100644
--- a/ErrList.dcu
+++ b/ErrList.dcu
Binary files differ
diff --git a/ErrList.dfm b/ErrList.dfm
index acd09ed..086c909 100644
--- a/ErrList.dfm
+++ b/ErrList.dfm
@@ -160,6 +160,7 @@
Top = 3
Width = 29
Height = 23
+ DoubleBuffered = True
Enabled = False
Glyph.Data = {
76010000424D7601000000000000760000002800000020000000100000000100
@@ -175,6 +176,7 @@
3333333333333333333333333333333333333333333333333333333333333333
3333333333333333333333333333333333333333333333333333}
NumGlyphs = 2
+ ParentDoubleBuffered = False
TabOrder = 0
OnClick = SitePreBtClick
end
@@ -183,6 +185,7 @@
Top = 3
Width = 29
Height = 23
+ DoubleBuffered = True
Enabled = False
Glyph.Data = {
76010000424D7601000000000000760000002800000020000000100000000100
@@ -198,6 +201,7 @@
3333333333773333333333333333333333333333333333333333333333333333
3333333333333333333333333333333333333333333333333333}
NumGlyphs = 2
+ ParentDoubleBuffered = False
TabOrder = 1
OnClick = SiteNextBtClick
end
@@ -250,6 +254,7 @@
Top = 3
Width = 31
Height = 23
+ DoubleBuffered = True
Enabled = False
Glyph.Data = {
76010000424D7601000000000000760000002800000020000000100000000100
@@ -265,6 +270,7 @@
3333333333333333333333333333333333333333333333333333333333333333
3333333333333333333333333333333333333333333333333333}
NumGlyphs = 2
+ ParentDoubleBuffered = False
TabOrder = 0
OnClick = RelaPreBtClick
end
@@ -273,6 +279,7 @@
Top = 3
Width = 31
Height = 23
+ DoubleBuffered = True
Enabled = False
Glyph.Data = {
76010000424D7601000000000000760000002800000020000000100000000100
@@ -288,6 +295,7 @@
3333333333773333333333333333333333333333333333333333333333333333
3333333333333333333333333333333333333333333333333333}
NumGlyphs = 2
+ ParentDoubleBuffered = False
TabOrder = 1
OnClick = RelaNextBtClick
end
diff --git a/ErrList.pas b/ErrList.pas
index ed4543d..9e60021 100644
--- a/ErrList.pas
+++ b/ErrList.pas
@@ -91,14 +91,15 @@
//********�Q�r�w���I��T********
ISB_BW: TImageScrollBox;
- SP1:TShape;//20170630 �s�[
+ {SP1:TShape;//20170630 �s�[
SP2:TShape;//20170630 �s�[
SP3:TShape;//20170630 �s�[
SP4:TShape;//20170630 �s�[
SP5:TShape;//20170630 �s�[
SP6:TShape;//20170630 �s�[
SP7:TShape;//20170630 �s�[
- SP8:TShape;//20170630 �s�[
+ SP8:TShape;//20170630 �s�[ }
+ SP : TShape;
procedure WMHotKey(var Msg: TWMHotKey); message WM_HOTKEY;
Procedure ShowOMRErr(Idx:Integer); //�e���W�q�XOMR�ˮ֥���
@@ -308,6 +309,8 @@
end;
procedure TErrlistForm.FormCreate(Sender: TObject);
+var
+ i : Integer;
begin
MyHotkeyid1 := GlobalAddAtom('MyHotkeyid1')- $C000;
RegisterHotKey(Handle, MyHotkeyid1,MOD_CONTROL,Ord('D'));
@@ -315,7 +318,17 @@
SiteList := TStringlist.Create;
RelaSiteList := TStringlist.Create;
ISB_BW:=TImageScrollBox.Create(Self);
- SP1:= TShape.Create(self);
+ for i := 1 to 30 do
+ begin
+ Sp := TShape.Create(self);
+ Sp.Name := 'SP'+inttostr(i);
+ end;
+ for i := 1 to 30 do
+ begin
+ Sp := TShape.Create(self);
+ Sp.Name := 'SP_R'+inttostr(i);
+ end;
+ {SP1:= TShape.Create(self);
SP1.Name := 'SP1';
SP2:= TShape.Create(self);
SP2.Name := 'SP2';
@@ -330,22 +343,32 @@
SP7:= TShape.Create(self);
SP7.Name := 'SP7';
SP8:= TShape.Create(self);
- SP8.Name := 'SP8';
+ SP8.Name := 'SP8'; }
end;
procedure TErrlistForm.FormDestroy(Sender: TObject);
+var
+ i : Integer;
begin
SiteList.Free;
RelaSiteList.Free;
ISB_BW.Free;
- SP1.Free;
+ for i := 1 to 30 do
+ begin
+ TShape(FindComponent('SP'+inttostr(i))).Free;
+ end;
+ for i := 1 to 30 do
+ begin
+ TShape(FindComponent('SP_R'+inttostr(i))).Free;
+ end;
+ {SP1.Free;
SP2.Free;
SP3.Free;
SP4.Free;
SP5.Free;
SP6.Free;
SP7.Free;
- SP8.Free;
+ SP8.Free;}
end;
procedure TErrlistForm.ImmediateBtClick(Sender: TObject);
@@ -382,6 +405,8 @@
end;
Procedure TErrlistForm.InitialData; //��_����������A
+var
+ i : Integer;
begin
SitePreBt.Enabled := False;
SiteNextBt.Enabled := False;
@@ -397,6 +422,14 @@
Siteidx := 1;
RelaSiteidx := 1;
DeleteBt.Enabled := False;
+ for i := 1 to 30 do
+ begin
+ TShape(FindComponent('SP'+inttostr(i))).Parent := nil;
+ end;
+ for i := 1 to 30 do
+ begin
+ TShape(FindComponent('SP_R'+inttostr(i))).Parent := nil;
+ end;
end;
Procedure TErrlistForm.GetOMRErrini(Index:String); //���ˮ֥���ini
@@ -478,7 +511,6 @@
//GetFFPoint(MpsViewX2,RelaFileName); //��FreeForm���Q�r�I���
//end;
-
ShowRelaOMRErr(RelaSiteIdx);
end;
@@ -536,9 +568,10 @@
begin
if RelaIdx > RelaSiteList.Count then Exit;
- SP := TShape(FindComponent('SP'+inttostr(RelaIdx+1))); //20170327 �b�j�餤�n�ϥΦh�վB�n
+ //SP := TShape(FindComponent('SP'+inttostr(RelaIdx+1))); //20170327 �b�j�餤�n�ϥΦh�վB�n
+ SP := TShape(FindComponent('SP_R'+inttostr(RelaIdx))); //20240314 Hong �令�o��
SP.Brush.Color :=$00FEFAAD;
- SP.Parent := ImageScrollBox1;
+ SP.Parent := ImageScrollBox2;
SP.Pen.Style := psSolid;
SP.Pen.Color := $00FEFAAD;
SP.Pen.Width := 1;
diff --git a/OldCaseInfo.dcu b/OldCaseInfo.dcu
index 991a270..a2dd530 100644
--- a/OldCaseInfo.dcu
+++ b/OldCaseInfo.dcu
Binary files differ
--
Gitblit v1.8.0