CLEAR ALL
CLOSE ALL
RELEASE ALL
CLEAR
qpdffile = GETFILE("PDF")
*--If you don't pass a pdf file it will prompt you for a directory
*--and if a directory is selected, it will print all .pdfs in that directory
print2pdf(qpdffile)
RETURN
FUNCTION print2pdf (pdffile)
IF TYPE('pdffile') <> "C"
pdffile = ""
ENDIF
*--Next line for test purposes only to select a printer
SET PRINTER TO NAME (GETPRINTER())
IF ".PDF" $ UPPER(pdffile)
=GOPDF(pdffile)
ELSE
m.lcPath = GETDIR()
=GOPDF(m.lcPath)
ENDIF
RETURN
FUNCTION GOPDF(qpath)
DO DECLexewait
#DEFINE INFINITE 0xFFFFFFFF
PRIVATE lcStartupInfo, lcProcInfo, hProcess, ;
lnPrio, lnIBelieve1
lnIBelieve1 = 1 && Don't remember what that was
lnPrio = 32 && Priority of Process=Normal
lcStartupInfo = CHR(68) + REPLI(CHR(0), 67)
lcProcInfo = REPLI(CHR(0), 16)
m.lcApp = "acrord32.exe"
lcresult = Acrofind()
IF !EMPTY(lcresult)
m.lcApp = lcresult
ENDIF
IF ! ".PDF" $ UPPER(qpath) && See if we should print all pdfs in a directory
=ADIR(pdfs,qpath+"*.PDF")
IF TYPE('ALEN(pdfs,1)') = "N"
FOR I = 1 TO ALEN(pdfs,1)
m.lccmdline = " /p /h"
m.lccmdline = m.lccmdline + qpath+pdfs(I,1)
IF FILE(qpath+pdfs(I,1))
IF YESNO('Print '+qpath+pdfs(I,1)+' ')
WAIT WINDOW "Printing "+qpath+pdfs(I,1)+"..." NOWAIT
=PrintPDF()
ENDIF
ENDIF
ENDFOR
ENDIF
ELSE
m.lccmdline = " /p /h"
m.lccmdline = m.lccmdline + qpath
IF FILE(qpath)
WAIT WINDOW "Printing "+qpath+"..." NOWAIT
=PrintPDF()
ENDIF
ENDIF
WAIT CLEAR
RETURN
FUNCTION PrintPDF
IF CreateProcess(0, m.lcApp+" "+m.lccmdline+CHR(0), 0,0,;
m.lnIBelieve1, m.lnPrio,;
0, 0, @lcStartupInfo, @lcProcInfo) <> 0
hProcess = buf2dword(SUBSTR(lcProcInfo, 1,4))
hThread = buf2dword(SUBSTR(lcProcInfo, 5,4))
lncount = 0
DOEVENTS
DO WHILE .T.
exitcode = 0 && initialize return value to 0
= GetExitCodeProcess(hProcess, @exitcode) && try to obtain process exit code
IF exitcode # 259 && not still busy
EXIT && fall out of loop
ELSE
lncount = lncount + 1
IF lncount < 45
*
ELSE
EXIT
ENDIF
ENDIF
= Sleep (100) && wait .1 seconds
ENDDO
= Sleep(1000)
= SendData('Adobe Reader')
= CloseHandle(hThread)
= CloseHandle(hProcess)
ELSE
=MESSAGEBOX("Unable to initiate AcroRd32.Exe")
ENDIF
RETURN
PROCEDURE DECLexewait
DECLARE INTEGER CreateProcess IN kernel32;
INTEGER lpAppName, STRING lpCmdLine, INTEGER lpProcAttr,;
INTEGER lpThrAttr, INTEGER bInhHandles, INTEGER dwCrFlags,;
INTEGER lpEnvir, INTEGER lpCurDir, ;
STRING @lpStInfo, STRING @lpProcInfo
DECLARE INTEGER GetLastError IN kernel32
DECLARE INTEGER CloseHandle IN kernel32 INTEGER hObject
DECLARE INTEGER WaitForSingleObject IN kernel32;
INTEGER hHandle, INTEGER dwMilliseconds
DECLARE INTEGER GetExitCodeProcess IN WIN32API INTEGER hProcess, INTEGER @lpExitCode
DECLARE Sleep IN kernel32 INTEGER dwMilliseconds
RETURN
FUNCTION buf2dword(lcBuffer)
RETURN ASC(SUBSTR(lcBuffer, 1,1)) + ;
ASC(SUBSTR(lcBuffer, 2,1)) * 256 +;
ASC(SUBSTR(lcBuffer, 3,1)) * 65536 +;
ASC(SUBSTR(lcBuffer, 4,1)) * 16777216
RETURN
*--------------
FUNCTION SendData
PARAMETER tcTitle
DECLARE INTEGER FindWindow IN Win32API AS FindWindow STRING, STRING
lnwindow = FindWindow(0,tcTitle)
IF lnwindow > 0
#DEFINE WM_CLOSE 16
#DEFINE WM_KEYDOWN 0x0100
#DEFINE WM_SYSCOMMAND 0x0112
#DEFINE WM_COMMAND 0x00110818
#DEFINE WM_KEYUP 0x0101
#DEFINE WM_SETFOCUS 0x0007
DECLARE SHORT PostMessage IN user32;
INTEGER HWND,;
INTEGER Msg,;
STRING wParam,;
INTEGER LPARAM
HWND = lnwindow
ReturnValue = PostMessage(HWND, WM_SETFOCUS, 0, 0)
ReturnValue = PostMessage(HWND, WM_CLOSE, 0, 0)
RELEASE oShell
RETURN .T.
ELSE
RETURN .F.
ENDIF
*------------------------------------------------------
PROCEDURE CloseApp
PARAMETERS hThread
DECLARE Sleep IN kernel32 INTEGER dwMilliseconds
=Sleep(100)
LOCAL awin_apps, vfp_handle, ln_current_window,ln_window_count
DIMENSION awin_apps[1,2]
vfp_handle=0
DECLARE INTEGER FindWindow ;
IN win32api ;
INTEGER nullpointer, ;
STRING cwindow_name
DECLARE INTEGER GetWindow ;
IN win32api ;
INTEGER ncurr_window_handle, ;
INTEGER ndirection
DECLARE INTEGER GetWindowText ;
IN win32api ;
INTEGER n_win_handle, ;
STRING @ cwindow_title, ;
INTEGER ntitle_length
ln_current_window = hThread
ln_window_count=0
DO WHILE ln_current_window>0
lc_window_title=SPACE(255)
ln_length=GetWindowText(ln_current_window, ;
@lc_window_title,LEN(lc_window_title))
IF ln_length>0
lc_window_title=STRTRAN(TRIM(lc_window_title),CHR(0),"")
ELSE
lc_window_title=""
ENDIF
IF ln_current_window>0 .AND. !EMPTY(lc_window_title)
ln_window_count=ln_window_count+1
DIMENSION awin_apps(ln_window_count,2)
awin_apps[ln_Window_Count,1]=lc_window_title
awin_apps[ln_Window_Count,2]=ln_current_window
ENDIF
ln_current_window=GetWindow(ln_current_window,2)
ENDDO
PRIVATE it
FOR it = 1 TO ALEN(awin_apps,1)
IF TYPE('awin_apps(it,1)')="C" .AND. "ADOBE" $ UPPER(awin_apps(it,1))
IF TYPE('awin_apps(it,2)')="N"
=close2(awin_apps(it,2))
ENDIF
ENDIF
IF TYPE('awin_apps(it,1)')="C" .AND. "ACROBAT" $ UPPER(awin_apps(it,1))
IF TYPE('awin_apps(it,2)')="N"
=close2(awin_apps(it,2))
ENDIF
ENDIF
IF TYPE('awin_apps(it,1)')="C" .AND. "DDE SERVER" $ UPPER(awin_apps(it,1))
IF TYPE('awin_apps(it,2)')="N"
=close2(awin_apps(it,2))
ENDIF
ENDIF
ENDFOR
RETURN .T.
*----------------------------------------------------------
PROCEDURE close2
PARAMETERS HWND
#DEFINE WM_CLOSE 16
#DEFINE WM_SETFOCUS 0x0007
#DEFINE WM_USER 0x0400
#DEFINE kMsg_Save 1235
DECLARE SHORT PostMessage IN user32;
INTEGER HWND,;
INTEGER Msg,;
STRING wParam,;
INTEGER LPARAM
DECLARE INTEGER SetForegroundWindow IN Win32API;
INTEGER HWND
DECLARE INTEGER SetActiveWindow IN Win32API;
INTEGER HWND
=PostMessage(HWND, WM_SETFOCUS, 0, 0)
=PostMessage(HWND, WM_CLOSE, 0, 0)
RETURN .T.
*--------------
FUNCTION SendN
PARAMETER lnwindow
IF lnwindow > 0
#DEFINE WM_KEYDOWN 0x0100
#DEFINE WM_SYSCOMMAND 0x0112
#DEFINE WM_COMMAND 0x00110818
#DEFINE WM_KEYUP 0x0101
#DEFINE WM_SETFOCUS 0x0007
DECLARE SHORT PostMessage IN user32;
INTEGER HWND,;
INTEGER Msg,;
STRING wParam,;
INTEGER LPARAM
HWND = lnwindow
ReturnValue = PostMessage(HWND, WM_SETFOCUS, 0, 0)
oShell = CREATEOBJECT("wscript.shell")
oShell.Sendkeys("N")
RELEASE oShell
RETURN .T.
ELSE
RETURN .F.
ENDIF
*----------------------------------------------------------------------
FUNCTION Acrofind
PRIVATE WNetGetConnection, lpszLocalname, lpszRemoteName, ;
sLen, Lni, DRIVE, Dtype, llfound, Lni
PRIVATE ARRAY afilesfound(1,3)
DIMENSION afilesfound(1,3)
afilesfound(1,1)=" "
llfound = .F.
Lni = 0
DECLARE INTEGER WNetGetConnection IN win32api ;
STRING lpszLocalName,;
STRING lpszRemoteName,;
INTEGER @ lpchBuffer && Declare the external WNetGetConnection ;
API FUNCTION
slpRemoteName = SPACE(254) && Initialize variables
sLen = LEN(slpRemoteName) && Initialize variables
*--Populate the one dimensional array with valid drive letters
FOR I = 1 TO 26 && Loop through drive letters A thru Z
DRIVE = CHR(I + 64)
Dtype = DRIVETYPE(DRIVE) && Determine drive type
DO CASE
CASE Dtype = 3 && Hard drives
Lni=Lni+1
DIMENSION adrivelist(Lni,3)
adrivelist(Lni,1)=DRIVE
adrivelist(Lni,2)=.F.
adrivelist(Lni,3)=.F.
CASE Dtype = 4 && Removable or network drives
iSuccess = WNetGetConnection(DRIVE + ;
":",@slpRemoteName,@sLen)
IF iSuccess = 0
Lni=Lni+1
DIMENSION adrivelist(Lni,3)
adrivelist(Lni,1)=DRIVE
adrivelist(Lni,2)=.F.
adrivelist(Lni,3)=.F.
ENDIF
ENDCASE
ENDFOR
llfound = .F.
FOR Lni = 1 TO ALEN(adrivelist,1)
FOR ib = 10 TO 1 STEP -1
lcacrofile = adrivelist(Lni,1)+":"+"\Program Files\Adobe\Acrobat "+ALLTRIM(STR(ib))+".0\Reader\AcroRd32.Exe"
IF FILE(lcacrofile)
llfound = .T.
EXIT
ENDIF
ENDFOR
IF llfound
EXIT
ENDIF
ENDFOR
CLEAR DLLS WNetGetConnection
IF llfound
RETURN lcacrofile
ELSE
RETURN ''
ENDIF
*----------------------------------------------------------------------
FUNCTION YESNO
LPARAMETER mmessage, mscheme, mtimeout, mtitle, myesno, mssgtop
IF EMPTY(mmessage)
mmessage = "Unknown Question."
ENDIF
IF EMPTY(mscheme)
mscheme = 7
ENDIF
IF EMPTY(mtimeout)
mtimeout = 0
ENDIF
IF EMPTY(mtitle)
mtitle = _SCREEN.CAPTION
ENDIF
IF EMPTY(myesno)
myesno = 0
ENDIF
IF ";" $ mmessage
mmessage = STRTRAN(mmessage, ';', ' ')
ENDIF
IF myesno = 0
IF mtimeout > 0
lnResult = MESSAGEBOX(mmessage, 36+4096, mtitle, mtimeout * 1000)
ELSE
lnResult = MESSAGEBOX(mmessage, 36+4096, mtitle)
ENDIF
ELSE
IF mtimeout > 0
lnResult = MESSAGEBOX(mmessage, 292+4096, mtitle, mtimeout * 1000)
ELSE
lnResult = MESSAGEBOX(mmessage, 292+4096, mtitle)
ENDIF
ENDIF
DO CASE
CASE lnResult = -1 && TimeOut
IF myesno = 0
lcChoice = "YES"
ELSE
lcChoice = "NO"
ENDIF
CASE lnResult = 1 && Ok
lcChoice = "OK"
CASE lnResult = 2 && Cancel
lcChoice = "CANCEL"
CASE lnResult = 3 && Abort
lcChoice = "ABORT"
CASE lnResult = 4 && Retry
lcChoice = "RETRY"
CASE lnResult = 5 && Ignore
lcChoice = "IGNORE"
CASE lnResult = 6 && Yes
lcChoice = "YES"
CASE lnResult = 7 && No
lcChoice = "NO"
OTHERWISE
lcChoice = "ESCAPE"
ENDCASE
RETURN lcChoice = 'YES'