Search  
Thursday, September 09, 2010 ..:: Forum ::.. Register  Login
 Forum Minimize
Pentru a putea posta mesaje trebuie să vă înregistraţi.
Notă: Mesajele cu conţinut jignitor sau ilegal (inclusiv cereri de soft piratat) nu sunt acceptate şi vor fi şterse imediat .

Pentru a primi raspunsuri rapide si corecte, scrieti in mesaj ce intentionati sa faceti, ce mesaj de eroare primiti, in ce context si in urma caror actiuni. De asemenea, mentionati versiunea de FoxPro in care lucrati!
SearchForum Home
  Profox  Anunturi administrative  Propunere modif...
 Propunere modificare FAQ
 
 8/6/2009 8:16:06 AM
User is offlineDoru Constantin
129 posts
5th




Propunere modificare FAQ
 (N/A)
Propun o modificare in FAQs - WIN32 API la:
Cum determin o procedură să aştepte executarea unui fişier executabil după care să continue rularea codului?

Am adaugat un parametru cWindowMode:
"NOR" = Normal window
"MIN" = Mininize window
"MAX" = Maximize window
"HID" = Hiden window

*--
Function DoAndWait(cExe, cWindowMode)

    Declare Integer CreateProcess In kernel32.Dll ;
        INTEGER lpApplicationName, ;
        STRING lpCommandLine, ;
        INTEGER lpProcessAttributes, ;
        INTEGER lpThreadAttributes, ;
        INTEGER bInheritHandles, ;
        INTEGER dwCreationFlags, ;
        INTEGER lpEnvironment, ;
        INTEGER lpCurrentDirectory, ;
        STRING @lpStartupInfo, ;
        STRING @lpProcessInformation

    Declare Integer WaitForSingleObject In kernel32.Dll ;
        INTEGER hHandle, ;
        INTEGER dwMilliseconds

    Declare Integer CloseHandle In kernel32.Dll ;
        INTEGER hObject

    #Define NORMAL_PRIORITY_CLASS 32
    #Define IDLE_PRIORITY_CLASS 64
    #Define HIGH_PRIORITY_CLASS 128
    #Define REALTIME_PRIORITY_CLASS 1600
    * Return code from WaitForSingleObject() if * it timed out.
    #Define WAIT_TIMEOUT 0x00000102
    * This controls how long, in milli secconds, WaitForSingleObject()
    * waits before it times out. Change this to suit your preferences.
    #Define WAIT_INTERVAL 200

    * STARTUPINFO is 68 bytes, of which we need to
    * initially populate the 'cb' or Count of Bytes member
    * with the overall length of the structure.
    * The remainder should be 0-filled
    * cStartUpInfo = long2str(68) + Replicate(Chr(0), 64)
    If (Vartype(cWindowMode) # "C") Or (Not Inlist(cWindowMode, "NOR", "MIN", "MAX", "HID"))
        cWindowMode = ""  &&  Use default of application
    Endif

    cWindowMode = Upper(cWindowMode)

    Do Case
        Case cWindowMode = "HID"
            *    Hide - use STARTF_USESHOWFLAG and value of 0
            cStartUpInfo = Chr(68) + Repl(Chr(0), 43) + Chr(1) + Repl(Chr(0), 3) + Chr(0) + Repl(Chr(0), 19)

        Case cWindowMode = "NOR"
            *    Normal - use STARTF_USESHOWFLAG and value of 1
            cStartUpInfo = Chr(68) + Repl(Chr(0), 43) + Chr(1) + Repl(Chr(0), 3) + Chr(1) + Repl(Chr(0), 19)

        Case cWindowMode = "MIN"
            *    Minimize - use STARTF_USESHOWFLAG and value of 2
            cStartUpInfo = Chr(68) + Repl(Chr(0), 43) + Chr(1) + Repl(Chr(0), 3) + Chr(2) + Repl(Chr(0), 19)

        Case cWindowMode = "MAX"
            *    Maximize - use STARTF_USESHOWFLAG and value of 3
            cStartUpInfo = Chr(68) + Repl(Chr(0), 43) + Chr(1) + Repl(Chr(0), 3) + Chr(3) + Repl(Chr(0), 19)

        Otherwise
            *    Use default of application
            cStartUpInfo = Chr(68) + Repl(Chr(0), 43) + Chr(0) + Repl(Chr(0), 3) + Chr(0) + Repl(Chr(0), 19)
    Endcase

    * PROCESS_INFORMATION structure is 4 longs,
    * or 4*4 bytes = 16 bytes, which we'll fill with nulls.
    cProcessInfo = Replicate(Chr(0), 16)
    * EXE name must be null-terminated
    cExe = cExe + Chr(0)
    * Call CreateProcess, obtain a process handle. Treat the
    * application to run as the 'command line' argument, accept
    * all other defaults. Important to pass the cStartUpInfo and
    * cProcessInfo by reference.
    RetCode = CreateProcess(0, cExe, 0, 0, 1, ;
        NORMAL_PRIORITY_CLASS, 0, 0, @cStartUpInfo, @cProcessInfo)
    * Unable to run, exit now. IF RetCode = 0 RETURN .F. ENDIF
    * Extract the process handle from the
    * PROCESS_INFORMATION structure.

    hProcess = str2long( Substr( cProcessInfo, 1, 4))
    Do While .T.
        * Use timeout of TIMEOUT_INTERVAL msec so the display
        * will be updated. Otherwise, the VFP window never repaints until
        * the loop is exited.
        If WaitForSingleObject( hProcess, WAIT_INTERVAL) != WAIT_TIMEOUT
            Exit
        Else
            DoEvents
        Endif
    Enddo
    * Close the process handle afterwards.
    RetCode = CloseHandle( hProcess)

    Return .T.

Endfunc

inspirat de aici:
http://www.universalthread.com/Report.aspx?Session=4B4C376D686F666C426A593D204B535A47346B4B63504D474F7A38446A4A6F3038576D5979336D384C32324567
 8/6/2009 9:19:38 AM
User is offlineadmin
16 posts


Re: Propunere modificare FAQ
 (N/A)

Updated. Verifica, te rog, daca functioneaza si daca e totul ok (initial nu mi-am dat seama ca n-ai inclus si functiile StrToLong, respectiv LongToStr, asa ca am suprascris tot ce era, punand codul tau in loc. Le-am luat din nou de pe net, de undeva, dar nu sunt sigur ca sunt identice. Verifica, te rog, daca ai timp, si da-mi de stire. Mersi. :)
 8/6/2009 10:54:52 AM
User is offlineDoru Constantin
129 posts
5th




Re: Propunere modificare FAQ
 (N/A) Modified By Doru Constantin on 8/6/2009 11:08:13 AM)
 admin wrote

Updated. Verifica, te rog, daca functioneaza si daca e totul ok (initial nu mi-am dat seama ca n-ai inclus si functiile StrToLong, respectiv LongToStr, asa ca am suprascris tot ce era, punand codul tau in loc. Le-am luat din nou de pe net, de undeva, dar nu sunt sigur ca sunt identice. Verifica, te rog, daca ai timp, si da-mi de stire. Mersi. :)



Functioneaza cu doua modificari:
LongToStr --> Long2Str
StrToLong --> Str2Long

sau (cum a fost inainte de modificare):

*--
Function Long2Str(nLong)
    m.nLong = Int(m.nLong)
    Return (Chr(Bitand(m.nLong, 255)) + ;
        chr(Bitand(Bitrshift(m.nLong, 8), 255)) + ;
        chr(Bitand(Bitrshift(m.nLong, 16), 255)) + ;
        chr(Bitand(Bitrshift(m.nLong, 24), 255)))
Endfunc

*--
Function str2long(cpLong)
    Return (Bitlshift(Asc(Substr(m.cpLong, 4, 1)), 24) + ;
        Bitlshift(Asc(Substr(m.cpLong, 3, 1)), 16) + ;
        Bitlshift(Asc(Substr(m.cpLong, 2, 1)), 8) + ;
        Asc(Substr(m.cpLong, 1, 1)))
Endfunc
 8/6/2009 11:05:44 AM
User is offlineDoru Constantin
129 posts
5th




Re: Propunere modificare FAQ
 (N/A) Modified By Doru Constantin on 8/6/2009 11:06:44 AM)
... sau, folosind functiile (optimizate pentru VFP9):

*--
Function Long2Str(tnLongVal)
    Local lcResult, i
    #If Version(5) >= 900
        lcResult = BinToC(tnLongVal, [4RS])
    #Else
        lcResult = ""
        For i = 24 To 0 Step -8
            lcResult = Chr(Int(tnLongVal / (2 ^ i))) + lcResult
            tnLongVal = Mod(tnLongVal, (2 ^ i))
        Endfor
    #Endif
    Return lcResult
Endfunc

*--
Function Str2Long(tcLongStr)
    Local lnResult, i
    #If Version(5) >= 900 Then
        lnResult = CToBin(tcLongStr, [4RS])
    #Else
        lnResult = 0
        For i = 0 To 24 Step 8
            lnResult = lnResult + (Asc(tcLongStr) * (2 ^ i))
            tcLongStr = Right(tcLongStr, Len(tcLongStr) - 1)
        Endfor
    #Endif
    Return lnResult
Endfunc
 8/6/2009 4:23:58 PM
User is offlineGrigore Dolghin
2937 posts
www.class-software.eu
1st






Re: Propunere modificare FAQ
 (N/A)
Done, thanks ;)
Grigore Dolghin
Visual FoxPro MVP 2006 - 2010
Class Software
My blog
 Page 1 of 1
NextPreviousNo Rating
  Profox  Anunturi administrative  Propunere modif...
Search  Forum Home         

 Google Ads Minimize
    

Copyright 2002-2007 Profox   Terms Of Use  Privacy Statement