Changeset 793 for cprs/branches/tmg-cprs/CPRS-Chart/UploadImages.pas

Timestamp:

Jun 10, 2010, 3:13:12 PM (14 years ago)

Author:

Kevin Toppenberg

Message:

update

File:

• cprs/branches/tmg-cprs/CPRS-Chart/UploadImages.pas (modified) (17 diffs)

cprs/branches/tmg-cprs/CPRS-Chart/UploadImages.pas

@@ -57 +57 @@
       destructor Destroy;  override;
   end;
-
-
-
-
 
 type
@@ -103 +99 @@
     Bitmap : TBitmap;
     Picture : TPicture;
+    FUploadedImagesList : TStringList; //List of strings of images succesfully uploaded.
     function MakeThumbNail(Info: TImageInfo): boolean;
 
@@ -126 +123 @@
   published
     property ScanDir : String read FScanDir write SetScanDir;
+    property UploadedImages : TStringList read FUploadedImagesList;
   end;
 
@@ -143 +141 @@
         ORNet, //for RPCBrokerV
         rTIU,
+        rHTMLTools,
         uTMGOptions
         ;
@@ -281 +280 @@
       RPCBrokerV.param[5].value := DOB;       RPCBrokerV.Param[5].ptype := literal;
       RPCBrokerV.param[6].value := Sex;       RPCBrokerV.Param[6].ptype := literal;
-      RPCBrokerV.Call;
+      //RPCBrokerV.Call;
+      CallBroker;
       RPCResult := RPCBrokerV.Results[0]; //returns: success: DFN;  or  error: -1^ErrMsg
       if piece(RPCResult,'^',1) <> '-1' then begin
@@ -321 +321 @@
     RPCBrokerV.ClearParameters := true;
     RPCBrokerV.remoteprocedure := 'TMG GET BLANK TIU DOCUMENT';
-    RPCBrokerV.param[0].value := DFN;       RPCBrokerV.param[0].ptype := literal;
+    RPCBrokerV.param[0].value := '`'+DFN;   RPCBrokerV.param[0].ptype := literal;
     RPCBrokerV.param[1].value := Provider;  RPCBrokerV.Param[1].ptype := literal;
     RPCBrokerV.param[2].value := Location;  RPCBrokerV.Param[2].ptype := literal;
     RPCBrokerV.param[3].value := DOS;       RPCBrokerV.Param[3].ptype := literal;
     RPCBrokerV.param[4].value := Title;     RPCBrokerV.Param[4].ptype := literal;
-    RPCBrokerV.Call;
+    //RPCBrokerV.Call;
+    CallBroker;
     RPCResult := RPCBrokerV.Results[0];
     try
@@ -436 +437 @@
     ErrorMsg                     : AnsiString;
     i                            : integer;
+    CacheFPathName, tempFName    : string;
 
   begin
@@ -464 +466 @@
     RPCBrokerV.Param[0].Mult['"FileExt"'] := 'EXT^' + Info.Extension;
 
-    for i := 0 to Info.pLongDesc.Count - 1 do begin
-      index := IntToStr(i);
-      while length(index) < 3 do index := '0' + index;
-      index :='"LongDescr' + index + '"';
-      RPCBrokerV.Param[0].Mult[index] := '11^' + Info.pLongDesc.Strings[i];
-    end;
-
-    RPCResult := RPCBrokerV.STRcall;   { returns ImageIEN^directory/filename }
+    if assigned(Info.pLongDesc) then begin
+      for i := 0 to Info.pLongDesc.Count - 1 do begin
+        index := IntToStr(i);
+        while length(index) < 3 do index := '0' + index;
+        index :='"LongDescr' + index + '"';
+        RPCBrokerV.Param[0].Mult[index] := '11^' + Info.pLongDesc.Strings[i];
+      end;
+    end;
+
+    //RPCResult := RPCBrokerV.STRcall;   { returns ImageIEN^directory/filename }
+    CallBroker;
+    if RPCBrokerV.Results.Count>0 then RPCResult := RPCBrokerV.Results.Strings[0];
 
     ImageIEN := Piece(RPCResult,'^',1);
     result := ((ImageIEN <> '0') and (ImageIEN <> ''));  // function result.
     if result=false then begin
-//    ErrorMsg :='Server Error -- Couldn''t store image information';  <-- original line.  //kt 8/7/2007
       ErrorMsg :=DKLangConstW('UploadImages_Server_Error_xx_Couldnxxt_store_image_information'); //kt added 8/7/2007
       MessageDlg(ErrorMsg,mtWarning,[mbOK],0);
@@ -485 +490 @@
       result := frmImages.UploadFile(Info.ImageFPathName,Info.ServerPath,Info.ServerFName,1,1);
       if result=false then begin
-//      ErrorMsg :='Error uploading image to server';  <-- original line.  //kt 8/7/2007
         ErrorMsg :=DKLangConstW('UploadImages_Error_uploading_image_to_server'); //kt added 8/7/2007
-        //Application.MessageBox(@ErrorMsg,'Error Uploading Image');
         MessageDlg(ErrorMsg,mtWarning,[mbCancel],0);
       end;
-      //Later, put code that also copies the file into the cache directory,
-      //so that we don't have to turn around and download it again.
       if result then begin
         RPCBrokerV.remoteprocedure := 'MAG3 TIU IMAGE';
@@ -498 +499 @@
         RPCBrokerV.Param[1].ptype := literal;
         RPCBrokerV.param[1].value := IntToStr(Info.TIUIEN);
-        RPCBrokerV.Call;
+        //RPCBrokerV.Call;
+        CallBroker;
         RPCResult := RPCBrokerV.Results[0];
         //returns:  success:  1^message;  or  error:  0^error message
@@ -504 +506 @@
         result := (MsgNum = '1');
         if result=false then begin
-//        ErrorMsg :='Error associating image with note:' + #13 + Piece(RPCResult,'^',2);  <-- original line.  //kt 8/7/2007
           ErrorMsg :=DKLangConstW('UploadImages_Error_associating_image_with_notex') + #13 + Piece(RPCResult,'^',2); //kt added 8/7/2007
           MessageDlg(ErrorMsg,mtWarning,[mbCancel],0);
         end;
       end;
-      if (result=true) and (MoveCheckBox.Checked) then begin
+      if (result=false) then exit;
+      //Copy the file into the cache directory, so that we don't have to turn around and download it again.
+      CacheFPathName := rHTMLTools.CPRSDir + '\cache\' + ExtractFileName (Info.ServerFName);
+      if not FileExists(CacheFPathName) then begin
+        tempFName := Info.ImageFPathName;
+        CopyFile(PChar(tempFName),PChar(CacheFPathName),FALSE);
+      end;
+      if (MoveCheckBox.Checked) then begin
         DeleteFile(Info.ImageFPathName);
       end;
-      if result then begin
-        if MakeThumbNail(Info) then begin;
-          result := frmImages.UploadFile(Info.ThumbFPathName,Info.ServerPath,Info.ServerThumbFName,1,1);
-          if result=false then begin
-//          ErrorMsg :='Error sending thumbnail image to server.';  <-- original line.  //kt 8/7/2007
-            ErrorMsg :=DKLangConstW('UploadImages_Error_sending_thumbnail_image_to_serverx'); //kt added 8/7/2007
-            MessageDlg(ErrorMsg,mtWarning,[mbOK],0);
-          end;
+      if MakeThumbNail(Info) then begin;
+        result := frmImages.UploadFile(Info.ThumbFPathName,Info.ServerPath,Info.ServerThumbFName,1,1);
+        if result=false then begin
+          ErrorMsg :=DKLangConstW('UploadImages_Error_sending_thumbnail_image_to_serverx'); //kt added 8/7/2007
+          MessageDlg(ErrorMsg,mtWarning,[mbOK],0);
+        end;
+        CacheFPathName := rHTMLTools.CPRSDir + '\cache\' + ExtractFileName (Info.ServerFName);
+        if not FileExists(CacheFPathName) then begin
+          CopyFile(PChar(Info.ImageFPathName),PChar(CacheFPathName),FALSE);
         end;
         if DelOrig=true then begin
@@ -559 +568 @@
       Info.Extension := MidStr(Info.Extension,2,17); //remove '.'
 
-      if not UploadFile(Info,MoveCheckBox.Checked) then begin   //Upload function passes back filename info in Info class
+      if UploadFile(Info,MoveCheckBox.Checked) then begin   //Upload function passes back filename info in Info class
+        FUploadedImagesList.Add(Info.ServerFName);
+      end else begin
         //Application.MessageBox('Error uploading image file!','Error');
       end;
-
     end;
     Info.Free;
@@ -616 +626 @@
     end;
     UploadChosenFiles();
+    //note This UploadButton has .ModalResult = mrOK, so form is closed after this.
   end;
 
@@ -642 +653 @@
     FormRefresh(self);
     FilesToUploadList.Items.Clear;
+    FUploadedImagesList.Clear;
     LoadNotesEdit();
     SetupVars;
@@ -666 +678 @@
     Bitmap.Width := 64;
     Picture := TPicture.Create;
+
+    FUploadedImagesList := TStringList.Create;
 
     AutoUploadNote := TAutoUploadNote.Create;
@@ -692 +706 @@
     Bitmap.Free;
     Picture.Free;
+    FUploadedImagesList.Free;
   end;
 
@@ -822 +837 @@
       Text.Add('</html>');
       Text.Add(' ');
-      rTIU.SetText(ErrMsg,Text,UploadNote.TIUIEN,1);  //1=commit data, do actual save.
+      rTIU.SetText(ErrMsg,Text,UploadNote.TIUIEN,0);  //elh changed from 1 to 0 //1=commit data, do actual save.
       Text.Free;
       //Here I autosign  -- later make this optional?
       RPCBrokerV.ClearParameters := true;
       RPCBrokerV.remoteprocedure := 'TMG AUTOSIGN TIU DOCUMENT';
-      RPCBrokerV.param[0].value := IntToStr(UploadNote.TIUIEN);  
+      RPCBrokerV.param[0].value := IntToStr(UploadNote.TIUIEN);
       RPCBrokerV.param[0].ptype := literal;
-      RPCBrokerV.Call;
-      RPCResult := RPCBrokerV.Results[0];    //returns:  error: -1;  success=1
+      //RPCBrokerV.Call;
+      CallBroker;
+      if RPCBrokerV.Results.Count > 0 then begin
+        RPCResult := RPCBrokerV.Results[0];    //returns:  error: -1;  success=1
+      end else begin
+        RPCResult := '-1';
+      end;
       if RPCResult='-1' then begin
         MessageDlg('Unable to set status for scanned document to SIGNED',mtError,[mbOK],0);
-      end;     
+      end;
       UploadNote.TIUIEN := 0;
     end;