Level Extreme platform
Subscription
Corporate profile
Products & Services
Support
Legal
Français
Any way to speed this up?
Message
 
 
To
16/05/2006 17:18:33
General information
Forum:
Visual FoxPro
Category:
Coding, syntax & commands
Environment versions
Visual FoxPro:
VFP 9 SP1
OS:
Windows XP
Database:
Visual FoxPro
Miscellaneous
Thread ID:
01122411
Message ID:
01122512
Views:
16
Tracy,

Thanks a lot. I'll try to adapt this code for my needs and try it. I currently can not connect to my work and I don't have printer at home, so this has to wait.

>This actually processes alittle faster for me:
>
>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)
>   =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'
>
If it's not broken, fix it until it is.


My Blog
Previous
Reply
Map
View

Click here to load this message in the networking platform