Ver 2,0,1,78

Hong-Dell\Hong

2024-03-14 f577443b19a16ee59a8ac5cc8f4745c09108d3e2

Ver 2,0,1,78

修改內容
1.調整影像上傳/下載先呼叫service/imgpsc/IMGPSC02/ftps ,使用HTTP/FTP(S)上傳/下載影像
2.新增FTP功能
3.修正檢視"檢核失敗項目",如有超過八組定位,會出現錯誤訊息的修正(調整檢核影像/檢核關係影像 各30組)

 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"/>

 CB_IMGPSScan.ocx

Binary files differ

 CB_IMGPSScan.res

Binary files differ

 CB_IMGPSScanImp.dcu

Binary files differ

 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

 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,7 +6620,13 @@
    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
@@ -6582,12 +6639,16 @@
  +'&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));
//ShowMessage('SendData='+SendData);
//ShowMessage(FData+#10#13+Doc_Data);
  //Showmessage('Wait');

  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+'.');
@@ -6607,6 +6668,40 @@
    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 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  ///不是新件、重掃件、異動件的不查

 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"/>

 CB_IMGPSScan_test.ocx

Binary files differ

 CB_IMGPSScan_test.res

Binary files differ

 ErrList.dcu

Binary files differ

 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

 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;

 OldCaseInfo.dcu

Binary files differ