** Noter que tout les exemple qui suivent requiert le declaration de ShellExcute
&& Exemple #1 - Forcer un changement d'imprimant par défaut et imprimer un document.
oNet = CreateObject('WScript.Network')
oNet.SetDefaultPrinter('\\ServerName\PrinterName')
DECLARE INTEGER ShellExecute IN shell32.dll ;
INTEGER hndWin, ;
STRING cAction, ;
STRING cFileName, ;
STRING cParams, ;
STRING cDir, ;
INTEGER nShowWin
cFileName = "d:\MyDocs\Chase.pdf"
cAction ="print"
=ShellExecute(0,cAction,cFileName,"","",1)
&& Exemple #2 - Comment ouvrir un exécutbale
cFileName = "c:\Program Files\Winzip\Winzip32.Exe" && Ceci assume que Winzip est dans ce répertoire
cAction = "open"
ShellExecute(0,cAction,cFileName,"","",1)
&& Ouvrir un fichier Zip
cFileName = "f:\Data\Archive.Zip"
cAction = "open"
ShellExecute(0,cAction,cFileName,"","",1)
&& Exemple #3 - Comment ouvrir un document DOC
cFileName = "d:\MyDocs\Chase.Doc"
cAction = "open"
ShellExecute(0,cAction,cFileName,"","",1)
&& Exemple #4 - Comment imprimer un document Doc
cFileName = "d:\MyDocs\Chase.Doc"
cAction = "print"
ShellExecute(0,cAction,cFileName,"","",1)
&& Exemple #5 - Comment ouvrir Internet explorer vers un lien
cFileName = "www.autoutfox.org"
cAction = "open"
ShellExecute(0,cAction,cFileName,"","",1)
&& Exemple #6 - Comment ouvrir Outlook Express avec l'adresse du récipiendaire déjà rempli
emailtext ="hello"
lcMail="mailto:me@rediffmail.com" + ;
"?subject=How To Send Mail" + ;
"&cc=ksupload@yahoo.com" + ;
"&bcc=copi@SomeoneElse.com" + ;
"&body="+emailtext
ShellExecute(0,"open",lcMail,"","",1)
&& Exemple #7 - Comment ouvrir Windows explorer sur un répertoire spécifique.
cFileName = "c:\data"
cAction = "open"
ShellExecute(0,cAction,cFileName,"","",1)
&& Exemple #8 - Comment faire jouer un fichier .wav
cFileName = "c:\music\Mozart.Wav"
cAction = "play"
ShellExecute(0,cAction,cFileName,"","",1)
&& Exemple 9 - Un exemple plus complet qui télécharge la liste complète des exemples trouvées sure && www.news2news.com qui combine SHELLEXECUTE - SOAP - TRY...CATH (VFP8.0) et Service Web. Clicker && sur le lien au bas du formulaire pour voir le code. Gracieuseté de Anatoliy Mogylevets.
PUBLIC objForm
objForm = CreateObject("Tform")
IF VARTYPE(objForm)="O"
objForm.Visible = .T.
ENDIF
* end of main
DEFINE CLASS Tform As Form
#DEFINE ccBaseAddr "http://www.news2news.com/vfp/"
#DEFINE ccWSDL "http://www.news2news.com/cgi-bin/w32/services/ws.php?wsdl"
#DEFINE ccUsrname "guest"
#DEFINE ccPwd ""
Caption=" VFP code samples on " + ccBaseAddr
Width=760
Height=500
MaxButton=.F.
MinButton=.F.
Autocenter=.T.
ShowTips=.T.
csList="cs" + SUBSTR(SYS(2015),3,10)
ws=0
ADD OBJECT pframe As Tframe WITH Left=6, Top=5, Width=748, Height=440
ADD OBJECT lblUrl As Label WITH Left=12, Top=460, Autosize=.T.,;
ForeColor=Rgb(0,0,192), FontUnderline=.T.,;
TooltipText="Click to open"
PROCEDURE Init
LOCAL ex As Exception, lError
lError=.F.
TRY
THIS.ws = CREATEOBJECT("mssoap.soapclient")
THIS.ws.mssoapinit(ccWSDL)
CATCH TO ex
THIS.ws_error(ex, "Could not initialize SOAP Client.")
lError=.T.
ENDTRY
IF m.lError
RETURN .F.
ENDIF
DECLARE INTEGER ShellExecute IN shell32;
INTEGER, STRING, STRING, STRING, STRING, INTEGER
THIS.pframe.Resize
THIS.PopulateList
PROTECTED PROCEDURE ws_error(ex, cCaption)
= MESSAGEBOX(TRANSFORM(ex.ErrorNo) + ". " +;
ex.Message + " " + CHR(13) + CHR(13) +;
"detail: " + TRANSFORM(THIS.ws.detail) + " " + CHR(13)+CHR(13) +;
"faultfactor: " + TRANSFORM(THIS.ws.faultactor) + " " + CHR(13) +;
"faultcode: " + TRANSFORM(THIS.ws.faultcode) + " " + CHR(13) +;
"faultstring: " + TRANSFORM(THIS.ws.faultstring) + " ",;
48, m.cCaption)
PROCEDURE Destroy
THIS.ws=Null
THIS.pframe.pgList.lst.RowsourceType = 0
IF USED(THIS.csList)
USE IN (THIS.csList)
ENDIF
PROCEDURE pframe.pgList.lst.InteractiveChange
ThisForm.lblUrl.Caption = ThisForm.GetUrl()
PROCEDURE lblUrl.MouseDown
LPARAMETERS nButton, nShift, nXCoord, nYCoord
= ShellExecute(0, "open", ThisForm.GetUrl(), "", "", 3)
PROCEDURE pframe.pgExample.Activate
ThisForm.DisplayExample
PROCEDURE pframe.pglist.lst.DblClick
ThisForm.pframe.ActivePage = 2
FUNCTION GetUrl
RETURN ccBaseAddr + "?example=" + ALLT(THIS.pframe.pgList.lst.Value)
PROCEDURE PopulateList
LOCAL cResult, ex As Exception
TRY
WAIT WINDOW NOWAIT "Retrieving list of examples..."
cResult = THIS.ws.GetListOfExamples()
XMLTOCURSOR(m.cResult, THIS.csList, 0)
CATCH TO ex
cResult=""
THIS.ws_error(ex, "SOAP error")
FINALLY
WAIT CLEAR
ENDTRY
IF USED(THIS.csList)
WITH THIS.pframe.pgList.lst
.RowsourceType = 2
.Rowsource = THIS.csList
.ColumnWidths="60,700"
IF .listCount > 0
.listIndex = 1
ENDIF
.InteractiveChange
ENDWITH
ENDIF
PROCEDURE DisplayExample
LOCAL nId, cResult, ex As Exception
nId = VAL(ThisForm.pframe.pgList.lst.Value)
TRY
WAIT WINDOW NOWAIT "Retrieving requested example..."
cResult = THIS.ws.GetExample(nId, ccUsrname, ccPwd)
XMLTOCURSOR(m.cResult, "csExample", 0)
CATCH TO ex
cResult=""
THIS.ws_error(ex, "SOAP error")
FINALLY
WAIT CLEAR
ENDTRY
IF USED("csExample")
WITH ThisForm.pframe.pgExample.txtSource
.Value = csExample.body
.Refresh
ENDWITH
USE IN csExample
ENDIF
ENDDEFINE
DEFINE CLASS Tframe As PageFrame
ADD OBJECT pgList As TpageList WITH Caption="List of examples"
ADD OBJECT pgExample As TpageExample WITH Caption="Source Code"
PROCEDURE Resize
WITH THIS.pgList
.lst.Width = THIS.Width - 14
.lst.Height = THIS.height - .lst.Top - 50
ENDWITH
WITH THIS.pgExample
.txtSource.Width = THIS.Width - 14
.txtSource.Height = THIS.height - .txtSource.Top - 50
ENDWITH
ENDDEFINE
DEFINE CLASS TpageList As Page && Page object
ADD OBJECT lst As ListBox WITH Left=5, Top=5, FontName="Arial",;
FontSize=10, ColumnCount=2, BoundColumn=1
ENDDEFINE
DEFINE CLASS TpageExample As Page && Page object
ADD OBJECT txtSource As EditBox WITH Left=5, Top=5,;
FontName="Courier New", FontSize=9, ForeColor = RGB(0,96,128)
ENDDEFINE
|
Retour à la liste
Canada
Fiche personnelle
Note des membres
le 19/12/2006,
Excellent