Dear Mr. Nages,
Can you please indicate me how to store and retireve a Pdf file with Ado?.
Many thanks. !
oRsCh:Fields("charter"):AppendChunk( VTArrayWrapper():New( 17, cBUFFER ) )
cREAD := oRsCh:Fields("charter"):GetChunk( oRsCh:Fields("datalen"):Value)
// Chimport.prg
#INCLUDE "FIVEWIN.CH"
#INCLUDE "XBROWSE.CH"
STATIC oDLG
//---------------------
FUNC _Chimport( oRsProj, cPROJECTEID, cMODE, oProj )
LOCAL SAYING
LOCAL oRsCh, cSQL, oERR
cDEFA := SET(7)
SysReFresh()
IF EMPTY( cPROJECTEID ) .or. cPROJECTEID = "BOGUS"
SAYING := "SORRY .. you can not Import a Charter until you"+CHR(10)
SAYING += "Save the Project record First .. Aborting"+CHR(10)
MsgInfo( SAYING )
_CleanUP()
RETURN(.F.)
ENDIF
IF EMPTY( cMODE )
cMODE := 'V'
ENDIF
/*
IF xSUPER = 'Y' .or. xPROJ = 'Y'
ELSE
SAYING := "SORRY ... You do not have Rights to run this Module"
MsgAlert( SAYING )
_cleanup()
RETURN(.F.)
ENDIF
*/
oRsCh := TOleAuto():New( "ADODB.Recordset" )
oRsCh:CursorType := 1 // opendkeyset
oRsCh:CursorLocation := 3 // local cache
oRsCh:LockType := 3 // lockoportunistic
cSQL := "SELECT * from CHARTER where PROJECTEID = '"+cPROJECTEID+"' order by date_imported"
TRY
oRsCh:Open( cSQL,xCONNECT )
CATCH oErr
MsgInfo( "Error in Opening CHARTER table" )
_CleanUP()
RETURN(.F.)
END TRY
IF oRsCh:eof
IF cMODE = "V"
SAYING := "SORRY .. No CHARTER has been Uploaded"
MsgInfo( SAYING )
oRsCh:CLose()
_CleanUP()
RETURN(.F.)
ENDIF
IF xPROJ = 'Y' .or. xSUPER = 'Y'
SAYING := "There are no CHARTER documents Loaded associated"+chr(10)
SAYING += "with this project named "+oRsProj:Fields("projname"):Value+chr(10)
SAYING += "Would you like to Import your CHARTER Now ?"+CHR(10)
IF MsgYesNo( SAYING )
IF _Cimport( oRsProj, oRsCh, cPROJECTEID )
ELSE
oRsCh:Close()
_CleanUP()
RETURN(.F.)
ENDIF
ELSE
oRsCh:Close()
_CleanUP()
RETURN(.F.)
ENDIF
ELSE
SAYING := "SORRY .. No CHARTER has been Uploaded"
MsgInfo( SAYING )
oRsCh:CLose()
_CleanUP()
RETURN(.F.)
ENDIF
ENDIF
// browse here for retrieval
StandardGrad()
_Charbrow( oRsCh, cPROJECTEID, oRsProj, cMODE, oProj )
oRsCh:CLose()
LightGreyGrad()
SysReFresh()
RETURN(.T.)
//------------------------
Static Func _Charbrow( oRsCh, cPROJECTEID, oRsProj, cMODE, oProj )
LOCAL SAYING,oBTN1,oBTN2,oBTN3,oBTN4
LOCAL oDLG,oLBX, cPROJNAME, cTITLE
IF EMPTY( cPROJECTEID ) .or. cPROJECTEID = "BOGUS"
SAYING := "In Order to View a Charter Document.. you have to IMPORT one First"
MsgInfo( SAYING )
RETURN(.F.)
ENDIF
IF cMODE = "A"
cMODE := "V"
ENDIF
cPROJNAME := oRsProj:Fields("projname"):Value
cPROJNAME := alltrim( cPROJNAME )
DO CASE
CASE cMODE = "E"
cTITLE := "CHARTER and SCHEDULE History for Project "+cPROJNAME+" EDIT"
OTHERWISE
cTITLE := "CHARTER and SCHEDULE History for Project "+cPROJNAME+" VIEW"
ENDCASE
DEFINE DIALOG oDlg RESOURCE "CHARBROW" ;
TITLE cTITLE ;
REDEFINE xBROWSE oLBX ;
RECORDSET oRsCh ;
ID 111 of oDlg ;
COLUMNS "date_imported",;
"imported_by", ;
"importtype", ;
"filename", ;
"datalen" ;
COLSIZES 90,90,90,200,90 ;
HEADERS "Date Import", ;
"Imported By",;
"ImportType", ;
"Filename", ;
"Bytes Loaded";
AUTOSORT AUTOCOLS LINES CELL
olBx:nRowHeight := 15
oLbx:bLDblClick := { |nRow,nCol |_Viewum( oRsCh, oPROJ, oDLG ) }
REDEFINE BUTTON oBTN1 ID 112 ;
ACTION ( oDLG:END() ) ;
DEFAULT
REDEFINE BUTTON oBTN2 ID 114 ; // view
ACTION ( _ViewUm( oRsCh, oProj, oDLG ) )
REDEFINE BUTTON oBTN3 ID 115 ; // import
ACTION ( _Cimport( oRsProj, oRsCh, cPROJECTEID ),;
oLBX:ReFresh(), SysReFresh() )
REDEFINE BUTTON oBTN4 ID 113 ; // delete
ACTION ( _DelUm( oRSCh, oLbx ),;
oLBX:ReFresh(), SysReFresh() )
ACTIVATE DIALOG oDlg ;
ON INIT ( _ChkButtons( cMODE, oBTN3, oBTN4 ) )
RETURN( .T. )
//-----------------------
Static Func _ChkButtons( cMODE, oBTN3, oBTN4 )
IF EMPTY(cMODE)
cMODE := "V"
ENDIF
IF cMODE = "A" // should have never got here in add mode
cMODE := "V"
ENDIF
IF cMODE = "V"
oBTN3:Hide()
oBTN4:Hide()
RETURN(NIL)
ENDIF
IF cMODE = "E"
DO CASE
CASE xSUPER = 'Y'
// do nothing show all buttons
CASE xPROJ = 'Y' .and. xSUPER <> 'Y'
oBtn4:Hide()
ENDCASE
ENDIF
RETURN(NIL)
//-----------------------------
Static Func _DelUm( oRs1, oLbx )
LOCAL SAYING,oErr
IF xSUPER = 'Y' .or. xProj = 'Y'
SAYING := "Are you SURE you want to DELETE this Imported Document ?"
IF MsgYesNo( SAYING )
Try
oRs1:Delete()
Catch
MsgInfo( "Delete Failed")
oLbx:SetFocus()
RETURN(.F.)
End try
TRY
oRs1:MoveNext()
CATCH
END TRY
IF oRs1:eof .and. .not. oRs1:bof
TRY
oRs1:MoveFirst()
CATCH
END TRY
ENDIF
ENDIF
ENDIF
oLbx:ReFresh()
*SysReFresh()
RETURN(.T.)
//-------------------------------
Static Func _Viewum( oRsCh, oPROJ, oDLG )
LOCAL nHANDLE, cREAD, cFILENAME
cFILENAME := alltrim(oRsCh:Fields("filename"):Value )
cREAD := oRsCh:Fields("charter"):GetChunk( oRsCh:Fields("datalen"):Value)
FERASE( xVOL+"\DBTMP\"+cFILENAME )
nHANDLE := FCREATE( xVOL+"\DBTMP\"+cFILENAME, 0 )
IF FERROR() <> 0
SAYING := "Error Creating file "+(xVOL+"\DBTMP\"+cFILENAME)+CHR(10)
SAYING += "Error "+STR(FERROR())+CHR(10)
MsgInfo( SAYING )
RETURN(.F.)
ENDIF
FWRITE( nHANDLE, cREAD ) // write out the file
FCLOSE( nHANDLE )
SysReFresh()
SHELLEXECUTE( "", "open", (xVOL+"\DBTMP\"+cFILENAME),"","",1)
SysReFresh()
RETURN(.T.)
//-------------------------
Static Func _Cimport( oRsProj, oRsCh, cPROJECTEID )
LOCAL lOK,oType,cType,oBtn1,oBtn2,cLocation,cPath,oPath
Local oFontB,aWinVer,oFont
Local oSay1,oSay2,oSay3,oSay4
Local cSay1,cSay2,cSay3,cSay4
cLOCATION := GetEnv( "USERPROFILE" )
If Empty( cLOCATION )
cLOCATION := "C:\"
Else
aWinVer := GetVersion()
IF aWinVer[1] = 5 // xp
cLOCATION := cLOCATION+"\MY DOCUMENTS"
Else
cLOCATION := cLOCATION+"\DOCUMENTS"
Endif
aDIR := DIRECTORY( cLOCATION+"\*.*","D" )
If Len( aDir ) > 0
Else
cLOCATION := "C:\"
Endif
Endif
// .t.
oFont := TFont():New("Ms Sans Serif",,-6,.F.,.F.,,,,.F. )
oFontB := TFont():New("Ms Sans Serif",,-6,.F.,.T.,,,,.F. )
lOK := .T.
cPATH := lower(cLocation) // "C:\*.PDF, *.DOC, *.DOCx"
cType := "CHARTER"
cSay1 := "The Project CHARTER is the official 'Executive Sponsorship' document that authorizes "
cSay1 += "this project, its approved resources, deliverables, goals/objectives, and constraints "
cSay1 += "for the life of the project. The CHARTER template can be found on our Intranet. "
cSay1 += "Please click on the line below to drill to the file location of your CHARTER document "
cSay1 += "you wish to Import for this project. You may attach updated versions, as needed."+chr(10)
cSay1 += " "+chr(10)
cSay1 += "A work breakdown structure (WBS) is a deliverable oriented decomposition of a project "
cSay1 += "into smaller components. It defines and groups a project’s discrete work elements in a "
cSay1 += "way that helps organize and define the total work scope of the project. A WBS also "
cSay1 += "provides the necessary framework for detailed cost estimating and control along with "
cSay1 += "providing guidance for schedule development and control."+chr(10)
cSay1 += " "+chr(10)
cSay1 += "A Project Schedule identifies each task needed to complete the scope of a project. "
cSay1 += "It defines the 'what, when and who' and assigns deadlines for their completion. "
cSay1 += "Scheduling requires a comprehensive understanding of which action steps need to "
cSay1 += "get done and when."
StandardGrad()
DEFINE DIALOG oDlg RESOURCE "CHIMPORT" ;
TITLE "CHARTER and SCHEDULE Import Routine" ;
REDEFINE SAY oSay1 PROMPT cSay1 ID 134 OF oDlg UPDATE
oSay1:SetFont( oFont )
REDEFINE SAY oSay2 /* PROMPT cSay1 */ ID 113 OF oDlg UPDATE
oSay2:SetFont( oFontB )
REDEFINE SAY oSay3 /* PROMPT cSay1 */ ID 114 OF oDlg UPDATE
oSay3:SetFont( oFontB )
REDEFINE SAY oSay4 /* PROMPT cSay1 */ ID 115 OF oDlg UPDATE
oSay4:SetFont( oFontB )
oSay4:SetColor( nRgb( 7,7,224 ))
REDEFINE COMBOBOX oType var cType ID 158 of oDlg ;
ITEMS { "CHARTER","PROJSCH" }
REDEFINE GET oPath var cPath ID 119 of oDlg BITMAP "search" ;
action( FileGet( @lOK,@cPath,oPath ) )
oPath:lAdjustBtn := .t.
oPath:bKeyDown:= {|nK| if( nK==VK_RETURN,FileGet( @lOK,@cPath,oPath ) , ) }
REDEFINE BTNBMP oBTN1 ID 111 of oDlg;
RESOURCE "OK", "DOK", "DOK" ;
PROMPT " &Ok " LEFT 2007;
ACTION ( lOK := _doit( oRsProj, oRsCH, cPROJECTEID,cType, @cPath ) )
REDEFINE BTNBMP oBTN2 ID 112 of oDlg ;
RESOURCE "CLOSE", "DCLOSE", "DCLOSE" ;
PROMPT "&Cancel" LEFT 2007;
ACTION ( lOK := .F., oDlg:End() )
ACTIVATE DIALOG oDlg
LightGreyGrad()
RELEASE oFontB
RELEASE oFont
RETURN( lOK )
//------------------------------
Static Func Fileget( lOK, cPath, oPath )
LOCAL SAYING,cLocation,aDir,nSize
SysReFresh()
IF lOK = .F.
oDLG:END()
RETURN(.F.)
ENDIF
/*
cPATH := cGETFILE( "PDF (*.pdf)| *.pdf|" + ;
"DOCx (*.docx)| *.docx|" + ;
"DOC (*.doc)| *.doc|" ;
,"Please select a file to Import", 4 )
*/
*cPATH := cGETFILE( "ALL | *.*|" , ;
* "Please select a file to Import( .Exe or .Dll not allowed)" )
cPATH := cGETFILE( "PDF (*.pdf)| *.pdf|" + ;
"DOCx (*.docx)| *.docx|" + ;
"DOC (*.doc)| *.doc|" + ;
"XLS (*.xls)| *.xls|" + ;
"XLSx (*.xlsx)| *.xlsx|" + ;
"All (*.*)| *.*|" ;
,"Please select a file to Import (.exe,.dll or files > 1gb are not Allowed", 6 )
cPATH := UPPER( alltrim(cPATH) )
/*
IF (AT( ".PDF", cPATH ) > 0 .or.;
AT( ".DOC", cPATH ) > 0 ).and. .not. EMPTY( cPATH )
ELSE
SAYING := "Sorry ... no files were chosen to import .. Aborting"
MsgInfo( SAYING )
oDLG:End()
lOk := .f.
RETURN(lOk)
ENDIF
*/
Do Case
Case AT( ".EXE", cPATH ) > 0
Saying := "Sorry ... .EXE files are not Allowed"
MsgInfo( Saying )
oDlg:End()
lOk := .f.
Return(lok)
Case AT( ".DLL", cPATH ) > 0
Saying := "Sorry ... .DLL files are not Allowed"
MsgInfo( Saying )
oDlg:End()
lOk := .f.
Return(lok)
Case EMPTY( cPATH )
Saying := "Sorry .. no files to Import"
MsgInfo( Saying )
oDlg:End()
lOk := .f.
Return(lok)
End Case
aDir := Directory( cPath )
nSize := aDir[1] [2]
If nSize > 1000000
Saying := "Sorry .. Your file size is greater than 1gb "+chr(10)
Saying += " "+chr(10)
Saying += lower(cPath)+chr(10)
Saying += "File Size "+ltrim(str(nSize/1000000))+"gb"+chr(10)
Saying += " "+chr(10)
Saying += "and can not be Uploaded .. Aborting"
MsgInfo( Saying )
oDlg:End()
lOk := .f.
Return(lok)
Endif
cPath := Lower( cPath )
oPATH:ReFresh()
SysReFresh()
lOk := .t.
RETURN(lOk)
//------------------------------
Static Func _Doit( oRsProj, oRsCh, cPROJECTEID, cType, cPath )
LOCAL cFILENAME, nSTRING, nLEN, nSTART, SAYING, nDATETIME
LOCAL nHANDLE, nBYTES, cEID, cFILE, dDATE
LOCAL cBUFFER //cBinaryData // <------- This is the actual data to be stored
LOCAL nBytesRead
cFILE := ALLTRIM( cPATH ) // C:\DBTMP\CHARTER.DOC
nLEN := LEN( cFILE )
nSTART := RAT( "\", cFILE )
IF nSTART > 0
ELSE
SAYING := "INVALID File name or Location .. Aborting"
MsgInfo( SAYING )
oDLG:END()
RETURN(.F.)
ENDIF
// get file name //
cFILENAME := SUBSTR( cPATH, nSTART+1, nLEN-nSTART ) // CHARTER.PDF
IF LEN(cFILENAME) > 35
SAYING := "Sorry .. the maximum length of your file"+chr(10)
SAYING += cFILENAME+CHR(10)
SAYING += "is longer than 35 characters. Please re-name"+chr(10)
SAYING += "your file to meet the 35 max length"+chr(10)
MsgInfo( saying )
oDlg:end()
RETURN(.F.)
ENDIF
// open file //
nHANDLE := FOpen( cFILE )
IF FERROR() <> 0
SAYING := "Error reading file "+cFILE+CHR(10)
SAYING += " "+STR(FERROR())+CHR(10)
MsgInfo( SAYING )
oDLG:END()
RETURN(.F.)
ENDIF
// get number of bytes in file
nBYTES := FSEEK( nHANDLE, 0,2 )
// pad the buffer nBytes+1
cBUFFER := SPACE(nBYTES+1)
FSeek( nHANDLE, 0, 0 )
nBytesRead := FRead( nHANDLE, @cBuffer, nBytes )
FClose( nHANDLE )
if nBytesRead != nBytes
SAYING := "nBytesRead = "+str(nBYTESREAD)+CHR(10)
SAYING += "nBytes = "+str(nBYTES)+CHR(10)
SAYING += "Error Reading Data"+chr(10)
MsgInfo( saying )
oDLG:END()
RETURN ( .F. )
endif
cEID := _GenEid()
IF cEID = "BOGUS"
oDlg:End()
RETURN(.F.)
ENDIF
nDateTime := dtoc(date())+" "+time()
oRsCh:AddNew()
oRsCh:Fields("chartereid"):Value := cEID
oRsCH:Fields("projecteid"):Value := cPROJECTEID
oRsCh:Fields("date_imported"):Value := nDateTime
oRsCh:Fields("imported_by"):Value := xLOGIN
oRsCh:Fields("datalen"):Value := nBYTES
oRsCh:Fields("filename"):Value := cFILENAME
oRsCh:Fields("IMPORTTYPE"):Value := cType
oRsCh:Fields("charter"):AppendChunk( VTArrayWrapper():New( 17, cBUFFER ) )
oRsCh:Update()
SysReFresh()
SAYING := "Bytes Read = "+str(nBYTESREAD)+CHR(10)
SAYING += "Bytes Stored = "+str(nBYTES)+CHR(10)
SAYING += " "+CHR(10)
SAYING += "Upload Complete for file name "+cFILENAME+chr(10)
MsgInfo( saying )
oRsCh:Sort("date_imported")
oRsCh:MoveFirst()
oRsCh:Find( "chartereid = '"+cEID+"'" )
oDLG:END()
RETURN(.T.)
//-------------------
Static Func _GenEid()
LOCAL nRAND, cRAND
LOCAL oRs, cSQL, oERR
oRs:= TOleAuto():New( "ADODB.Recordset" )
oRs:CursorType := 1 // opendkeyset
oRs:CursorLocation := 3 // local cache
oRs:LockType := 3 // lockoportunistic
cSQL := "SELECT chartereid from CHARTER"
TRY
oRs:Open( cSQL,xCONNECT )
CATCH oErr
MsgInfo( "Error in Opening CHARTER table to Create Unique EID" )
RETURN("BOGUS")
END TRY
cRAND := 'BOGUS'
DO WHILE .T.
nRAND := nRANDOM(10000000000000000)
// 1 is reserved and 0 is a null key //
IF nRAND = 1 .or. nRAND = 0 .or. nRAND = NIL
LOOP
ENDIF
cRAND := STRZERO(nRAND,18)
IF oRs:eof
ELSE
oRs:MoveFirst()
oRs:Find("chartereid = '"+cRAND+"'" )
ENDIF
IF oRs:eof
EXIT
ELSE
LOOP
ENDIF
EXIT
ENDDO
oRs:Close()
RETURN( cRAND )
//--------------------
Static Func _CleanUP()
oPATH := NIL
cPATH := NIL
oDLG := NIL
RETURN(.T.)
elvira wrote:Dear Mr. Nages,
Can you please indicate me how to store and retireve a Pdf file with Ado?.
Many thanks. !
Return to FiveWin for Harbour/xHarbour
Users browsing this forum: Google [Bot] and 52 guests