Ver 2,0,1,80

Hong-Dell\Hong

2024-07-04 630dbb00b682c2e5ebee6ec666694441230b29cf

 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