MIME-Version: 1.0 Content-Type: multipart/related; boundary="----=_NextPart_01CD69C7.7BE92DE0" This document is a Single File Web Page, also known as a Web Archive file. If you are seeing this message, your browser or editor doesn't support Web Archive files. Please download a browser that supports Web Archive, such as Windows® Internet Explorer®. ------=_NextPart_01CD69C7.7BE92DE0 Content-Location: file:///C:/ECF61CD2/Slide2.htm Content-Transfer-Encoding: quoted-printable Content-Type: text/html; charset="windows-1252"
<=
span
style=3D'font-size:48.0pt;line-height:115%;mso-bidi-font-family:Calibri;
mso-bidi-theme-font:minor-latin;color:black;mso-themecolor:text1'>Présentat=
ion
de Microsoft Visual FoxPro juin 2012 Paris.
par Mike Gagnon=
span><=
span
style=3D'font-size:48.0pt;line-height:115%;mso-bidi-font-family:Calibri;
mso-bidi-theme-font:minor-latin;color:black;mso-themecolor:text1'>
1.
Slide #3 – questi=
on
#1
Windows Management Instrumentation est une technologie de gestion de ba=
se
de Windows, vous pouvez utiliser WMI pour gérer des ordinateurs locaux et d=
istants.
Le mot «Instrumentation» dans WMI se réfère au fait que WMI peut obtenir des
informations sur l'état interne des systèmes informatiques, tout comme les
instruments de bord des voitures peut récupérer et afficher des informations
sur l'état du moteur. WMI fournit une approche cohérente à la réalisation de
tâches de gestion au jour le jour avec les langages de programmation ou de
scripting. On peut accéder aux données de WMI, la plupart du temps par requ=
ête
SQL et le résultat de cette requête nous donnes une collection de propriété=
s.
Qu'est-ce que=
une ressource gérée? Pour les fins=
du
présent chapitre, une ressource gérée est tout autre matériel informatique=
span> (hardware), logiciels, un
service, un compte d'utilisateur, et ainsi de suite qui
peut être gérée à l'aide de WMI
Les requêtes SQL sont exécutées =
sur différentes
classes. Il existe 10 groupes de classes dans Windows.
i)
Les classes Win32
ii)
Les classes WMI de b=
ase
de registre.
iii)
Les classes WMI de
système.
iv)
Les classes WMI moniteur d'affichage.
v)
Les classes IPMI (=
span>Intellige=
nt
Platform
vi)
Management Interface)
vii)
Les classes MSFT.
viii)Les classes CMI (Intelligent Platform Management Interface)
ix)
Les classes
de consommation cou=
rante.
x)
Les classes MSMCA.
xi)
Les classes WMI C++.=
Nous allons aujourd’hui nous
concentrer sur une ou deux de ces classes. Mais les requêtes à faire sur les
autres classes sont habituellement faites dans le même style.
Les classes Win 32.
On retrouve 6 sous-catégories de
classe Win32. Les classes Win32,=
comme
Win32_NetworkAdapter ou <=
span
class=3Dhps>Win32_Process, surveiller et gérer le =
matériel
du système et des fonctionnalités. Généralement, ces classes sont situées=
dans
le root <=
span
class=3Dhps>\ cimv2 .
i)
Classe de matériel informatique du système
=
ii) Classe d'applications installées.
iii)
Classes de systèmes d'exploitation.
iv)
Classes de compteur de performa=
nce.
v)
Aide descripteur de sécurité de classe
vi)
wmi service de gestion de classe
Classe de matériel informatique du système.
Cette classe est
subdivisée en 10 sections et chaque subdivision a aussi ses sous-divisions.
Alors on peut voir l’ampleur et l’utilité de WMI lorsque l’on veut développ=
er
une application pour gérer un parc informatique sous tous ses aspects.
Microsoft nous fournit aussi un outil pour écrire nos requêtes (Code Creato=
r –
démontrer C:\June2012\WMI\code cre=
ator).
Le code qui en ressort est en Visual Basic, mais la traduction à FoxPro est
très facile.
On peut aussi profit=
er d’IntelliSense
de Foxpro pour obtenir les propriétés que nous avons de besoin.
LOCAL lcComputerName, loWMIService, loItems,
loItem, lcMACAddress
lcComputerName =3D "."
loWMIService =3D GETOBJECT("winmgmts:\\" + lcComputerN=
ame
+ "\root\cimv2")
loItems =3D loWMIService.ExecQuery("Select * from Win32_NetworkAdapter",,48)<= o:p>
FOR EACH loItem IN loItems
?loItem.GetObjectText_
ENDFOR
Exemples.
1. NetworkAdapterConfiguration.pr=
g
2. ProcessorID.prg
3. Numerodeserie.prg
4. Adressemac.prg
5. DisplayControler1.prg
6. Operating system (op.exe)
Classe d’applications installées.
Vous pouvez trouver plusieurs
exemples de scripts que Microsoft met à votre disposition site le site de
Microsoft http://technet.microsoft.com/en-ca/scriptcenter/dd793613.
1.
Plusieurs programmeu=
rs
FoxPro cherchent à découvrir ou utiliser l’information interne d’un ordinat=
eur
pour protéger par exemple contre l’utilisation illégale d’une application. =
Cette
méthode n’est pas une bonne pratique puisque chaque manufacturier peut déci=
der
de stocker le numéro de série d’un disque dur (par exemple) dans un autre
endroit, et votre code ne retournera pas le numéro de série et aussi les
composantes d’un ordinateur peuvent changer plusieurs fois dans la vie de
l’ordinateur donc empêcher une application de démarrer parce qu’elle ne tro=
uve
pas le bon numéro de série ne fait que frustrer le client. Surtout si ce cl=
ient
est éloigné. Une meilleur moyen de protéger une application est une clé
électronique mais encore là il y a toujours moyen de contourner cette prati=
que.
Une pratique moderne et courante mais pas parfaite est au lieu de juste
chercher la présence d’une clé électronique, mais plutôt de mettre une fonc=
tion
principale (comme la vérification du mot de passe) sur la clé électronique =
dans
un DLL .Net, qui n’a pas besoin d’être enregistré, et si la clé électronique
n’est pas présente, le logiciel ne part pas.
Windows API (Application programming interfaces)
C=
ommunément
appelé Win32 API, qui reflète le support de 32 bit. Ce sont des DLL (en 16 =
bits
ces DLL étaient des exécutables) que presque tous les programmes sous la
plateforme Windows interagissent avec ces DLL d’une façon ou une autre. Cer=
tains
de ces DLL qui exposent des interfaces (comctl32.dll) ont été porté aussi en
OCX pour leur son utilisation dans les applications comme Foxpro et autres.
N=
ous
retrouvons 8 catégories de base pour ces DLL.
L=
es
services de base.
L=
es
services avancés.
GDI
User Interface
Common dialog library.
Common control library
Windows shell
W=
indows
services.
<= o:p>
1.&n=
bsp;
clear
DECLARE INTEGER GetSystemDirectory IN kernel32;
STRING=
@ lpBuffer, INTEGE=
R nSize
LOCAL lpBuffer, nSizeRet
lpBuffer =3D SPACE (250)
nSizeRet =3D
GetSystemDirectory(@lpBuffer, Len
lpBuffer =3D SUBSTR (lpBuffer, 1, nSizeRet)
? lpBuffer
2.&n=
bsp;
arrêt / redémarrage du système =
(ou annuler), démarrer / arrêter / créer un service Windows, gérer les co=
mptes
utilisateurs. Ces fonctions sont contenues dans le DLL advapi32.dll.
Voici un exemple de son utilisation (éteindre un ordinateur) (remarqu=
ez
que ce code nous donne une erreur et nous allons voir plutard pourquoi)
Declare Integer GetLastError In kernel32
Declare Integer InitiateSystemShutdownA In advapi32;
AS InitiateSystemShutdown ;
STRING lpMachineName, String lpMessage,;
INTEGER dwTimeout, SHORT =
bForceAppsClosed,;
SHORT bRebootAfterShutdown
Local cMachineName, nResult
cMachineName=3D"&qu=
ot;
nResult=3DInitiateSystem=
Shutdown(cMachineName,;
"System Shutdown
initiated...", 10, 0, 1)
If nResult =3D 0
* Common reasons for fai=
lure
include an invalid
* or inaccessible comput=
er
name or insufficient privilege.
* 5 =3D ERROR_ACCESS_DENIED
* 53 =3D ERROR_BAD_NETPATH
* 120 =3D
ERROR_CALL_NOT_IMPLEMENTED -- not supported in Win9*
? "Error code:", GetLastError()
Endif
3.&n=
bsp;
Gra=
phics
Device Interface. Fournit une
fonctionnalité de
sortie du contenu graphique pour les
moniteurs, les imprimantes et
autres périphériques de sortie. =
Il
réside dans GDI.EXE sur Windows 16 bits, et gdi32.dll sur Windows
32 bits en mode utilisate=
ur.
Celui est le DLL que le nouvel engin que les reports de Visual Foxpro versi=
on 9
utilisent.
Il n’y a pas d’exemple simple pour l’utilisation du GDI32.dll puisque
pour l’utiliser on doit faire appel à plusieurs autres fonctions pour les c=
ombiner
pour pouvoir obtenir le résultat désiré. Mais vous pouvez consulter le site
Atoutfox ou vous trouverez quelques exemples que moi et d’autres on poste.
http://ww=
w.atoutfox.org/articles.asp?ACTION=3DFCONSULTER&ID=3D0000000124
4. User Interface. Fournit les fonctionnalités pour créer et
gérer des fenêtres d'écran et les
contrôles les plus élémentaires, tels que <=
span
class=3Dhps>des boutons et des barres de défilemen=
t,
de recevoir la souris et du clav=
ier,
et d'autres fonctionnalités asso=
ciées à
la partie GUI de Windows.=
Cette unité fonctionnelle réside dans<=
/span> user.exe sur =
Windows 16
bits, et user32.dll sur Windows 32 bits. Voici un exemple =
de son
utilisation (comment obtenir le hWnd de la fenêtre active, même si les form=
es
Foxpro nous donnent cette information, parfois on veut savoir le hWnd d’une=
fenêtre
autre qu’une forme Foxpro, comme la calculatrice de Windows) =
Declare Integer GetActiveWindow In user32
HWnd =3D GetActiveWindow()
? HWnd
5.
Common Di=
alog
Box Library (Bibliothèque<=
/span> boîte de dialogue commune) Fournit des applications=
l=
es
boîtes de dialogue standard d'ou=
verture
et de sauvegarde de fichiers, choisir
la couleur et la police, =
etc.
La bibliothèque se trouve dans u=
n
fichier appelé COMMDLG.DLL sur Windows 16 bits, et
comdlg32.dll sur Windows
32 bits. Voici un exemple de son utilisation (comment utiliser le sé=
lecteur
de couleur de Windows, qui est plus complet que celui de Foxpro)
DO declare
#DEFINE CC_RGBINIT 1
#DEFINE CC_FULLOPEN 2
#DEFINE CC_PREVENTFULLOPEN 4
#DEFINE CC_SHOWHELP 8
#DEFINE CC_SOLIDCOLOR 128
#DEFINE CC_ANYCOLOR 256
#DEFINE CC_WIDE 32
*| typedef struct {
*| DWORD=
lStructSize; 0:4
*| HWND =
hwndOwner; 4:4
*| HWND =
hInstance; 8:4
*| COLORREF
rgbResult; 12:4
*| COLORREF
* lpCustColors; 16:4
*| DWORD=
Flags; 20:4
*| LPARAM
lCustData; 24:4
*| LPCCHOOKPROC lpfnHook; 28:4
*| LPCTSTR
lpTemplateName; 32:4
*| } CHOOSECOLOR,
*LPCHOOSECOLOR; total=3D36 bytes
#DEFINE CHOOSECOLOR_SIZE 36
*| typedef DWORD COLORRE=
F;
*| typedef DWORD
*LPCOLORREF;
*| 0x00bbggrr
#DEFINE COLORREF_ARRAY_SIZE 64
LOCAL hWindow, lcBuffer, lnInitColor, lnFlags,;
lnCus=
tColors,
lcCustColors, ii
hWindow =3D GetActiveWin=
dow()
* the color initially
selected when the dialog box is created
lnInitColor =3D <=
span
lang=3DEN-US style=3D'font-size:10.0pt;font-family:"Courier New";color:blue;
mso-ansi-language:EN-US'>Rgb(128,0,0)
* allocating memory block
for 16 COLORREF values (DWORD)
* for the custom color b=
oxes
in the dialog box
* and filling this memory
with zeroes
#DEFINE GMEM_FIXED 0
lnCustColors =3D
GlobalAlloc(GMEM_FIXED, COLORREF_ARRAY_SIZE)
=3D ZeroMemory(lnCustCol=
ors,
COLORREF_ARRAY_SIZE)
* initialization flags
lnFlags =3D CC_FULLOPEN +
CC_RGBINIT
* compiling the CHOOSECO=
LOR
structure
lcBuffer =3D
num2dword(CHOOSECOLOR_SIZE) +;
num2dword(hWindow) +;
num2dword(0) +;
num2dword(lnInitColor) +;
num2dword(lnCustColors) +;
num2dword(lnFlags)=
+;
num2dword(0) +;
num2dword(0) +;
num2dword(0)
IF ChooseColor(@lcBuffer) <> 0
* the OK button of the
dialog box has been selected
?
"Color selected:", buf2dword(SUBSTR(lcBuffer, 13,4))
?
"Custom colors stored:"
* cop=
ying
the memory block content to a VFP string
* just to have an opportunity to work=
with
its substring;
* quite weird way, though not much ch=
oice
available
*
considering the VFP specifics
lcCus=
tColors
=3D Repli(Chr(0), COLORREF_ARRAY_SIZE)
=3D Heap2Str(@lcCustColors, lnCustCol=
ors,
COLORREF_ARRAY_SIZE)
FOR =
span>ii=3D1 TO
? ii, buf2dword(SUBSTR(lcCustColor=
s,
(ii-1)*4+1, 4))
ENDFOR=
ENDIF
* free the memory block =
if
you do not use it for the
* following calls to this
function
=3D GlobalFree(lnCustCol=
ors)
* end of main
FUNCTION num2dword (lnValue)
#DEFINE m0 0x100
#DEFINE m1 0x10000
#DEFINE m2 0x1000000
LOCAL =
b0, b1, b2, b3
b3 =3D Int(lnValue/m2)
b2 =3D Int((lnValue - b3*m2)/m1)
b1 =3D Int((lnValue - b3*m2 - b2*m1)/m0)
b0 =3D Mod(lnValue, m0)
RETURN Chr(b0)+Chr
FUNCTION buf2dword (lcBuffer)
#DEFINE MAX_DWORD 0xffffffff
#DEFINE MAX_LONG 0x7FFFFFFF
LOCAL =
lnResult
lnResult =3D Asc(SUBSTR=
(lcBuffer, 1,1)) + ;
Asc(SUBSTR=
(lcBuffer, 2,1)) * 256 +;
Asc(SUBSTR=
(lcBuffer, 3,1)) * 65536 +;
Asc(SUBSTR=
(lcBuffer, 4,1)) * 16777216
RETURN IIF(lnResult>MAX_LONG, lnResult-MAX_DWORD, lnResul=
t)
PROCEDURE declare
DECLARE
INTEGER ChooseColor IN comdlg32 STRING @lpcc
DECLARE
INTEGER GetActiveWindow IN user32
DECLARE
INTEGER GlobalFree IN kernel32 INTEGER hMem
DECLAR=
E RtlZeroMemory IN kernel32 As ZeroMemory;
INTEGER dest, INTEGER numBytes
DECLARE
INTEGER GlobalAlloc IN kernel32;
INTEGER wFlags, INTEGER dwBytes
DECLAR=
E RtlMoveMemory IN kernel32 As Heap2Str;
STRING @, INTEGER, <=
span
style=3D'font-size:10.0pt;font-family:"Courier New";color:blue'>INTEGER
<= o:p>
6. Common Control Library (Bibliothèque<=
/span> de contrôle commun) Donne des applications l'a=
ccès
à certains contrôles avancés fournis par le système d'exploitation. Il s'ag=
it
notamment des choses comme les barres d'état, barres de progression, barres
d'outils et les onglets. La bibliothèque se trouve dans un fichier DLL appe=
lé
commctrl.dll sur Windows 16 bits, et comctl32.dll sur Windows 32 bits. Voic=
i un
exemple de son utilisation (un peu compliquer de news2news :
LOCAL oForm As
oForm=3DCREATEOBJECT(&quo=
t;Tform")
oForm.Show
READ EVENTS
* end of main
DEFINE CLASS Tform As Form
Caption =3D "SysLink Control"
Height=
=3D160
Width<=
/span>=3D360
Autoce=
nter=3D.T.
ShowWi=
ndow=3D2
* add
before adding first comctl32 control =
span>
ADD OB=
JECT
Comctl32Manager1 As Comctl32Manager
* the
angled brackets are replaced with Chrs
* for presentation purposes only, sin=
ce
they are
* HTM=
L special
characters
ADD OB=
JECT
SysLink1 As SysLink WITH;
Left=
span>=3D15, Top
LinkCaption=3D[Visit our ]+
[a href=3D"www.downloadpa=
ge.com"]+CHR(62)+=
;
[download page]+CHR(60)+[/a]+= span>CHR(62)+[ ] +;<= o:p>
[or ]+CHR(60)+[a
href=3D"mailto:support@domain.com"]+;
CHR(62)+[contact us]+CHR(60)+[/a]+CHR(62)+[ by email.]
ADD OB=
JECT
SysLink2 As SysLink WITH;
Left=
span>=3D40, Top
LinkCaption=3D[Choose feedback:] + =
span>CHR(13) +;
[
- ]+CHR(60)+[a ID=3D"idComment"]+CHR(62)+;
[Comment]+CHR(60)+[/a]+CHR(62)+[] + CHR(13) +;
[
- ]+CHR(60)+[a ID=3D"idQuestion"]+CHR(62)+;
[Question]+CHR(60)+[/a]+CHR(62)+[] + CHR(13) +;
[
- ]+CHR(60)+[a ID=3D"idComplaint"]+CHR(62)+;
[Complaint]+CHR(60)+[/a]+=
span>CHR(62)+[]
ADD OB=
JECT
SysLink3 As SysLink WITH;
Left=
span>=3D25, Top
LinkCaption=3DCHR(60)+[a ID=3D"idHelp"]+CHR(62)+;
[Help]+CHR(60)+[/a]+CHR(62)
ADD OB=
JECT
shp As Shape WITH Left=3D10,;
Top=3D116, Width=3D340, Height=3D1
ADD OB=
JECT
cmdClose As CommandButton WITH;
Left=3D260, Top=3D124, Width=3D80, Height=3D27,;
Caption=3D"Close", Cancel=3D.T.
PROCEDURE Destroy
CLEAR EVENTS
PROCEDURE cmdClose.Click<= o:p>
ThisForm.Release
PROCEDURE SysLink1.OnClick
ACTIVA=
TE
SCREEN
WITH THIS.oNMLink
? THIS.CtrlId, .litem_iLink,;
.litem_szID, .litem_szUrl
ENDWIT=
H
PROCEDURE SysLink2.OnClick
ACTIVA=
TE
SCREEN
WITH THIS.oNMLink
? THIS.CtrlId, .litem_iLink,;
.litem_szID, .litem_szUrl
ENDWIT=
H
PROCEDURE SysLink3.OnClick
ACTIVA=
TE
SCREEN
WITH THIS.oNMLink
? THIS.CtrlId, .litem_iLink,;
.litem_szID, .litem_szUrl
ENDWIT=
H
ENDDEFINE
DEFINE CLASS Comctl32Manager As Custom
#DEFINE GWL_WNDPROC -4
#DEFINE GWL_HINSTANCE -6
#DEFINE WS_VISIBLE 0x10000000
#DEFINE WS_CHILD 0x40000000
#DEFINE HWND_TOP 0
#DEFINE SWP_NOSIZE 0x0001
#DEFINE SWP_NOMOVE 0x0002
#DEFINE SWP_SHOWWINDOW 0x0040
#DEFINE WM_NOTIFY 0x004e
#DEFINE WM_USER 0x0400
#DEFINE LM_GETIDEALSIZE WM_USER+0x0301
#DEFINE LWS_NOPREFIX 0x0004
#DEFINE LWS_TRANSPARENT 0x0001
#DEFINE LWS_USEVISUALSTYLE 0x0008
#DEFINE NM_FIRST 0
#DEFINE NM_CLICK (NM_FIRST-2)
#DEFINE NM_RETURN (NM_FIRST-4)
#DEFINE NM_SETFOCUS (NM_FIRST-7)
#DEFINE NM_CUSTOMDRAW (NM_FIRST-12)
#DEFINE MAX_LINKID_TEXT 48
#DEFINE L_MAX_URL_LENGTH 2084
#DEFINE NMHDR_SIZE 12
#DEFINE LITEM_SIZE 4280
#DEFINE NMLINK_SIZE NMHDR_SIZE+LITEM_SIZE
Visibl=
e=3D.F.
hParentHwnd=3D0
hOrigProc=3D0
Comctl32Controls=3DNULL
PROCEDURE Init
WITH THIS
.declare
.hParentHwnd=3DThisForm.hWnd
.hOrigProc=3DGetWindowLong(.hParentHwnd, GWL_WNDPROC)
.Comctl32Controls=3DCREATEOBJECT<=
/span>("Collection")
* comctl32 messaging is conducted
* via WM_NOTIFY messages
BINDEVENT(THIS.hParentHwnd, WM_NOTIFY,;
THIS, "WindowProc", 1)
* release first
BINDEVENT(ThisForm, "Destroy", <=
/span>THIS,
"ReleaseControls", 1)
ENDWIT=
H
PROCEDURE Destroy
IF THIS.hParentHwnd <> 0
UNBINDEVENTS(THIS.hParentHwnd, WM_NOTIFY)
THIS.hParentHwnd=3D0
THIS.hOrigProc=3D0
ENDIF<= o:p>
PROCEDURE ReleaseControls
DO WHI=
LE
THIS.Comctl32Controls.Count > 0
THIS.Comctl32Controls.Remove(1)
ENDDO<= o:p>
PROTECTED PROCEDURE KeyFromCtrlId(nCtrlId As Number) As String
RETURN "c_" + PADL(TRANSF=
ORM(m.nCtrlId),5,"0")
PROTECTED PROCEDURE ControlIsRegistered(nCtrlId As Number) As Boolean
LOCAL =
oControl As Comctl32Control, lResult
oControl=3DTHIS.ControlFromCtrlId(nCtrlId)
lResult=3DNOT ISNULL(m.oControl)
oCont=
rol=3DNULL
RETURN m.lResult
PROTECTED PROCEDURE ControlFromCtrlId(nCtrlId As Number) As Comctl32Control
LOCAL =
cCtrlKey, oControl As Comctl32Control,;
ex As Exception
cCtrl=
Key=3DTHIS.KeyFromCtrl=
Id(m.nCtrlId)
TRY
oControl=3DTHIS.Comctl32Controls.Item(m.cCtrlKey)
CATCH =
TO ex
oControl=3DNULL
ENDTRY
RETURN m.oControl
PROCEDURE RegisterControl(oControl As Comctl32Control)
LOCAL =
cCtrlKey, ex As
Exception
IF EMPTY(oControl.CtrlId)
oControl.CtrlId=3D0x1000 +;
THIS.Comctl32Controls.Count
ENDIF
cCtrl=
Key=3DTHIS.KeyFromCtrl=
Id(oControl.CtrlId)
TRY
THIS.Comctl32Controls.Add
CATCH =
TO ex
ENDTRY=
PROTECTED PROCEDURE WindowProc
PARAMETERS hWindow as Integer, nMsgID as Int=
eger,;
wParam as Integer, lParam as Integer
LOCAL =
nReturn, oNmhdr As NMHdrStruct
oNmhdr=3DCREATEOBJECT("NMHdrStruct"=
)
oNmhdr.FromPtr(m.lParam)
nReturn =3D CallWindowProc(
m.nMsgID, m.wParam, m.lParam)
IF THI=
S.ControlIsRegistered( oNmhdr.idFrom )
THIS.OnCtrlEvent(m.oNmhdr, m.hWindow,;
m.nMsgID, m.wParam, m.lParam)=
ENDIF<= o:p>
RETURN m.nReturn
PROTECTED PROCEDURE OnCtrlEvent
PARAMETERS oNmhdr As
wParam as Integer, lParam as Integer
LOCAL =
oControl As Comctl32Control
oControl=3DTHIS.ControlFromCtrlId( oNmhdr.idFrom )
WITH <=
/span>oControl
.EventId=3DoNmhdr.EventId
.OnCtrlEvent(m.hWindow, m.nMsgID,
m.wParam, m.lParam)
ENDWIT=
H
PROTECTED PROCEDURE declare
DECLAR=
E RtlMoveMemory IN kernel32 As MemToStr;
STRING @, INTEGER, INTEGER
DECLARE INTEGER DestroyWindow IN
INTEGER hWindow
DECLARE
INTEGER GetWindowLong IN user32;
INTEGER hWindow, INTEGER nIndex
DECLARE
INTEGER CreateWindowEx IN user32 AS CreateWindow;
INTEGER dwExStyle, STRING lpClassName,=
;
STRING lpWindowName, INTEGER dwStyle,;
INTEGER x, INTEGER y, INTEGER nWidth, INTEGER nHeight,;
INTEGER hWndParent, INTEGER hMenu, INTEGER hInstance,;<= o:p>
INTEGER lpParam
DECLARE
INTEGER SendMessage IN user32;
AS SendMessageStr;
INTEGER hWindow, INTEGER Msg,;
INTEGER wParam, STRING @lParam
DECLARE
INTEGER SetWindowPos IN user32;
INTEGER hWindow, INTEGER hWndInsertAf=
ter,;
INTEGER x, INTEGER y, INTEGER cx, INTEGER cy,;
INTEGER wFlags
DECLARE
INTEGER CallWindowProc IN user32;
INTEGER lpPrevWndFunc, INTEGER hWindow, LONG Msg,;
INTEGER wParam, INTEGER lParam
ENDDEFINE
DEFINE CLASS Comctl32Control As Container && Container,
TextBox
hPare=
ntWindow=3D0
hWindow=3D0
EventId=3D0
CtrlId=3D0
PROCEDURE Init
WITH THIS
.hParentWindow=3DThisForm.Hwnd
.RegisterControl
.DisplayObject
ENDWIT=
H
PROCEDURE Destroy
THIS.DestroyObject
PROTECTED PROCEDURE DestroyObject
IF THI=
S.hWindow <> 0
=3D DestroyWindow(THIS.hWindow)
THIS.hWindow=3D0
ENDIF<= o:p>
PROTECTED PROCEDURE RegisterControl
ThisFo=
rm.Comctl32Manager1.RegisterControl(THIS)
PROCEDURE DisplayObject =
span>&& abstract
PROCEDURE OnCtrlEvent && abstract
PARAMETERS hWindow as Integer, nMsgID as Int=
eger,;
wParam as Integer, lParam as Integer
ENDDEFINE
DEFINE CLASS SysLink As
oNMLink=3DNULL
LinkC=
aption=3D""
PROCEDURE Init
Comct=
l32Control::Init()
THIS=
span>.oNMLink=3DCREATE=
OBJECT("oNMLinkStruct")
PROCEDURE OnCtrlEvent
PARAMETERS hWindow as Integer, nMsgID as Int=
eger,;
wParam as Integer, lParam as Integer
Comct=
l32Control::OnCtrlEvent(m.hWindow,
m.nMsgID,;
m.wParam, m.lParam)
WITH T=
HIS
DO CASE
CASE .EventId=3DNM_CLICK
.oNMLink.FromPtr(m.lParam)
.OnClick
ENDCASE
ENDWITH
PROCEDURE OnClick <=
/span>&& abstract
PROCEDURE DisplayObject
LOCAL =
nStyle, hApp, cSizeBuffer
WITH T=
HIS
.DestroyObject
*!* nStyle =3D BITOR(WS_VISIBLE,
WS_CHILD,;
*!* LWS_NOPREFIX, LWS_TRANSPA=
RENT,;
*!* LWS_USEVISUALSTYLE)
nStyle =3D BITOR(WS_VISIBLE, WS_CHILD)
hApp =3D GetWindowLong(.hParentWi=
ndow,
GWL_HINSTANCE)
.hWindow =3D CreateWindow(0, "SysLink",;
.LinkCaption, nStyle, .Left, .Top,;
.Width, .Height,;
.hParentWindow, .CtrlId, hApp=
, 0)
cSizeBuffer=3DREPLICATE(CHR(0), 8)
=3D SendMessageStr(.hWindow,
LM_GETIDEALSIZE,;
.Width, @cSizeBuffer)
.Height=3Dbuf2dword(SUBSTR(cSizeBuffer,5,4))
=3D SetWindowPos(.hWindow, HWND_T=
OP,;
0, 0, .Width, .Height,;
BITOR(SWP_NOMOVE, SWP_SHOWWINDOW))
ENDWIT=
H
ENDDEFINE
DEFINE CLASS NMHdrStruct As
Relation
hwndF=
rom=3D0
idFrom=3D0
EventId=3D0
PROCEDURE FromPtr(nAddr As Number)
LOCAL =
cBuffer
cBuffer =3D REPLICATE(CHR(0), NMHDR_SIZE)
MemToStr(@cBuffer, m.lParam, NMHDR_SI=
ZE)
WITH T=
HIS
.hwndFrom =3D buf2dword(SUBSTR=
(m.cBuffer,1,4))
.idFrom =3D buf2dword(SUBSTR(m.cBuffer,5=
,4))
.EventId =3D buf2dword(
ENDWIT=
H
ENDDEFINE
DEFINE CLASS oNMLinkStruct As Relation
NMHdr=
=3DNULL
litem=
_iLink=3D0
litem_szID=3D""
litem_szUrl=3D""
PROCEDURE FromPtr(nAddr As Number)
LOCAL =
cBuffer
cBuffer =3D REPLICATE(CHR(0), NMLINK_SIZE)
MemToStr(@cBuffer, m.lParam, NMLINK_S=
IZE)
WITH T=
HIS
.NMHdr=3DCREATEOBJECT("NMHdrStruct")
.NMHdr.FromPtr(m.nAddr)
.litem_iLink =3D buf2dword(SUBSTR(m.cBuffer,1=
7,4))
.litem_szID =3D .GetStr(@cBuffer,=
29,
MAX_LINKID_TEXT)
.litem_szUrl =3D .GetStr(@cBuffer,
29+MAX_LINKID_TEXT*2,;
L_MAX_URL_LENGTH)
ENDWIT=
H
PROTECTED FUNCTION GetStr(cBuffer, nStart, nLength) As String
LOCAL =
cResult
cResult=3DSTRCONV(SUBSTR=
(m.cBuffer, m.nStart, m.nLength*2), 6)
RETURN STRTRAN(m.cResult, CHR(0), "")
ENDDEFINE
FUNCTION buf2dword(cBuffer)
RETURN Asc(SUBSTR=
(cBuffer, 1,1)) + ;
BitLSh=
ift(Asc
BitLSh=
ift(Asc
BitLShift(Asc(SUBSTR(cBuffer, =
4,1)),
24)
7.
Windows
Shell . =
Composante de
l'API Windows permet aux applications d'acc=
éder
aux fonctionnalités fournies par le shell du système d'exploitation, ainsi que=
span> modifier et l'améliorer. La composante réside dans shell.dll sur Windows
16 bits, et shell32.dll s=
ur
Windows 32 bits. Voici un exemple de son
utilisation :
LOCAL form
form =3D CreateObject(&quo=
t;Tform")
oForm.Show(1)
* end of main
DEFINE CLASS Tform As Form
Width=3D480
Height=3D300
BorderStyle=3D2
MaxButton=3D.F.
MinButton=3D.F.
Caption=3D"Control Panel Functions"
Autocenter=3D.T.
ADD OBJECT lst As ListBox WITH;
Left=3D8, Top=3D5, Width=3D464, Height=3D210
ADD OBJECT Label1 As Label WITH;
Left=3D10, Top=3D228, Caption=3D"Command:", Autosize=3D.T.
ADD OBJECT txtCmd As TextBox WITH;
Left=3D80, Top=3D226, Height=3D24, Width=3D384, ReadOnly=3D.T.
ADD OBJECT cmdRun As CommandButton WITH;
Left=3D382, Top=3D256, Height=3D27, Width=3D80, Caption=3D"Run"
PROCEDURE Init
THIS.lst.InteractiveChange
PROCEDURE lst.Init
ThisForm.AddCmd(&quo=
t;System,
General property page", "shell32.dll,Control_RunDLL
sysdm.cpl,,0")
ThisForm.AddCmd("Desktop property page",
"shell32.dll,Control_RunDLL desk.cpl,,0")
ThisForm.AddCmd("Add New Printer wizard",
"shell32.dll,SHHelpShortcuts_RunDLL AddPrinter")
ThisForm.AddCmd("Add Hardware Wizard",
"shell32.dll,Control_RunDLL hdwwiz.cpl")
ThisForm.AddCmd("Install/Uninstall tab selected",
"shell32.dll,Control_RunDLL appwiz.cpl,,1")
ThisForm.AddCmd("Set Date & Time properties tab",
"shell32.dll,Control_RunDLL timedate.cpl")
ThisForm.AddCmd("Fonts Folder in Explorer view",
"shell32.dll,SHHelpShortcuts_RunDLL FontsFolder")
ThisForm.AddCmd("Internet Properties, General Tab",
"shell32.dll,Control_RunDLL inetcpl.cpl")
ThisForm.AddCmd("Mouse Properties", "shell32.dll,Control_RunD=
LL
main.cpl @0")
ThisForm.AddCmd("Keyboard Properties, Speed tab",
"shell32.dll,Control_RunDLL main.cpl @1")
ThisForm.AddCmd("Multimedia/Audio property page",
"shell32.dll,Control_RunDLL mmsys.cpl,,0")
WITH THIS
.RowSourceType=3D2
.RowSource=3D"csCommands"
.ListIndex=3D1
ENDWITH
PROCEDURE lst.InteractiveCh=
ange
ThisForm.txtCmd.Value =3D
"rundll32.exe " +;
ALLTRIM(csCommands.params)
PROCEDURE AddCmd(cName, cParams)
IF Not USED("csCommands")
CREATE CURSOR csCommands (cmdname C(50), params C(100))
ENDIF
INSERT INTO csCommands <=
/span>VALUES ("
"+m.cName, m.cParams)
PROCEDURE cmdRun.Click
ThisForm.RunCmd1(&qu=
ot;rundll32.exe",
ALLTRIM(csCommands.params))
PROCEDURE RunCmd1(cApp, cParam)
DECLARE
INTEGER ShellExecute IN shell32;
<=
/span>INTEGER hwnd, STRING lpOperation,=
;
<=
/span>STRING lpFile, STRING lpParameters=
,;
<=
/span>STRING lpDirectory,=
INTEGER nShowCmd
=3D ShellExecute(0, "open", cApp, cParam, "&quo=
t;, 1)
PROCEDURE RunCmd2(cApp, cParam)
DECLARE INTEGER WinExec IN kernel32;
STRING lpCmdLine, INTEGE=
R nCmdShow
=3D WinExec(cApp + " " + cParam, 1)
ENDDEFINE
8.
Network
Services (services de réseau)
Donner accès à des capac=
ités de
réseautage différents du =
système
d'exploitation. Ses sous-=
composants
comprennent NetBIOS, Winsock, NetDDE, RPC e=
t beaucoup
d'autres. Vous pouvez trouver des exemples de Winsock avec vfpwinsock
ici :
9.
On peut aussi retrouver d’autres DLL qui peuvent être=
considérés
comme DLL de base de Windows, même si ils ne le sont pas. En voici des
exemples :
a.
shdocvw.dll, mshtml.dll, msxml*.dll, urlmon.dll (pour=
le
web browser)
b.
Pour le multimedia, tous les DLL de DirectX.
Exemples :
RawInput.prg
SetLayeredWindowAttribute.prg
SHBrowseForFolder.prg
iswow64process.prg
getnameinfo.prg
compression.PRG
roach.prg
TexttoImages.prg
Position.prg
=
Extendedmessagebox.prg
AUTOMATION
AVEC VISUAL FOXPRO.
I=
l existe
de nombreux logiciels qui peuvent être automatisées. Voici une liste d'entre
eux et leur méthode d'appel.
<= o:p>
AccPac=
Advantage Corporate: oAccPac=3D=
CreateObject('ACCPAC.xapiSession')
AccPac Report Master for Windows:
Bar Tender:
Crystal Reports:
This doesn't invoke an IDE actually.
EUDORA: oEud =3D CreateObject("Eudora.EuApplication.1")
=
FaxMaker<=
span
lang=3DEN style=3D'font-size:12.0pt;font-family:"Arial","sans-serif";color:=
#111111;
mso-ansi-language:EN'>: oFax =3D
CREATEOBJECT("fmfaxapi.application")
File System Object oFSO =3D
CREATEOBJECT("Scripting.FileSystemObject")
(no IDE)
Group Wise oGroupWise=
=3D
CreateObject("NovellGroupWareSession")
LotusNotes: oNotes =3D CreateObject("Notes.Notes=
Session")
oNotes =3D CreateObject("Notes.NotesUIWorkspace")
oNotes =3D CreateObject("Lotus.Notessession") (Domino
5.0.3)
MS Access: oAccess =3D CreateObject("Access.Application")
<=
span
lang=3DEN style=3D'font-size:12.0pt;font-family:"Arial","sans-serif";color:=
#111111;
mso-ansi-language:EN'>
MS Common Dialog: oCommmonDialog =3D
CreateObject("MSComDlg.CommonDialog")
&&
!!! You can't directly create this object without a development licence, so=
for
dynamically doing it on another machine, see below.
-- Peter Crabtree
MSExcel: oExcel =3D
CreateObject("Excel.Application")
MS Front Page:
MS Graph: oGraph =3D CreateObject("MSGraph.Application")
<=
span
lang=3DEN style=3D'font-size:12.0pt;font-family:"Arial","sans-serif";color:=
#111111;
mso-ansi-language:EN'>
MS Internet Explorer: oIE =3D
CreateObject("InternetExplorer.Application")
MS Map Point: oMapPoint =
=3D
CreateObject("MapPoint.Application")
MSN Messenger: oMessenger =3D CREATEOBJECT("MSNMess=
enger.MessengerApp")
MS Net Meeting:
MS Outlook: oOutlook =3D
CreateObject("Outlook.Application")
MS PowerPoint: oPP =3D
CreateObject("PowerPoint.Application")
MS Project: oProj =3D
CreateObject("msProject.Application")
MS Source Safe:
MS Word: oWord =3D CreateObject("Word.Application")
MS Visio: oVisio =3D CreateObject("Visio.Application")
MS Visual Basic: ?
MS Visual CPlus Plus: oCpp =3D
CreateObject("MSDev.Application")
MS Visual Foxpro:
MS Windows Scripting Host: oWSH =3D
CreateObject("WScript.Shell")
Novell Group Wise oGroupWise=
=3D
CreateObject("NovellGroupWareSession")
PCAnywhere (host): oPCAHost =3D
CreateObject("WinAWSvr.BeHostDataManager")
PCAnywhere (remote): oPCARem =3D
CreateObject("WinAWSvr.RemoteDataManager")
QuickBooks:
Rational Rose:
oSnag =3D
CreateObject("SnagIt.ImageCapture.1")
TAPIFax: oTAPIFax =3D CreateObject('FaxServer.FaxServer')
WindowsShell<=
/a>: oWSH =3D
CreateObject("Shell.Application")
Windows Media Player:
oWMP =3D CREATEOBJECT("WMPlayer.OCX")
=
oPlayList =3D oWmp.PlaylistCollection.GetAll()
<=
pre>oWmp.currentPlaylist =3D oPlayList.Item(0) && Zero based array<=
o:p>*!* Music starts!
Windows Messenger: oMessenger =3D
CREATEOBJECT("Messenger.MessengerApp")
Win Fax: oWinFax =3D
CreateObject("WinFax.SDKSend")
Win Print : oWinPrint =3D
CreateObject("WinPrint.WinPrintX")
loSQL =3D
CREATEOBJECT("SQLDMO.Application")
Scripting Shell: oShell =3D
CreateObject("WScript.Shell")
Scripting Network Object: oNet =3D
CreateObject("WScript.Network")
Scripting Regular Expression Parser: oReg =3D CreateObject("VBScript.RegExp")
SQL DMO SQL Server: CreateObject("=
;SQLDMO.SQLServer")
Vous remarquerez que=
ces
automations n’ont pas tous des interfaces. Comme CDO (Collaboration Data
Object).
CDO permet d’envoyer=
des
courriels avec ou sans attachements, en HTML ou texte etc… CDO n’est plus u=
n ‘wrapper’ de MAPI comme l’était CDO1.2 m=
ais utilise.
Même si CDO est beaucoup plus simple que MAPI, il permet d’accomplir la plu=
part
des taches requises. CDO, à compar=
er à
CDONTS, permet d’envoyer des courriels en utilisant un service SMTP local o=
u un
serveur SMTP à distance. CDONTS peut juste utiliser un serveur SMTP à dista=
nce
avec IIS. Il existe aussi une version de CDO qui agit avec Microsoft Exchan=
ge
(CDOEX).
CDO est unidirection=
nel,
on peut seulement envoyer des courriels. Pour recevoir des courriels, il fa=
ut utiliser
autre chose comme Winsock.
Le DLL principal pour
envoyer des courriels est CDOSYS.DLL.
Voici quelques
exemples (vous trouverez d’autres exemples ici http://www.atoutfox.or=
g/articles.asp?ACTION=3DFCONSULTER&ID=3D0000000040)
Comment envoyer un
simple courriel :
oMSG =3D <=
span
style=3D'color:blue'>CREATEOBJECT("cd=
o.message")
oMSG.To =3D &qu=
ot;me@nowhere.com"
oMSG.From =3D &=
quot;me"
oMSG.Subject =3D "Hello Email"
oMSG.TextBody =3D "This is an easy way to cr=
eate an
email"
oMSG.Send()
C=
omment
envoyer un courriel avec attachement:
oMSG =3D createobje=
ct("CDO.Message")
oMSG.To =3D &qu=
ot;me@nowhere.com"
oMSG.From =3D &=
quot;me@nowhere.com"
oMSG.Subject =3D "Hello Email"
oAtt=3DoMSG.AddAttachment('c:\myfile.txt')=
&&oAtt=3DoMSG.AddAttachment('c:\myfile2=
.txt')
&& Pour 2 attachements
oMSG.Send()
<= o:p>
Si vous recevez un message comme=
CDO.M= essage.1 error '80040220' The "SendUsing" configuration value is invalid.<= o:p>
Ceci
veut dire que votre ordinateur n’est pas configure avec un service SMTP. On peut soit configurer un service SMTP =
sur le
poste local, ou utiliser le code qui suit (en spécifiant un serveur SMTP
externe)
#Define CRLF Chr(13)+Chr(10)
#Define cdoSendUsingPickup 1
#Define
cdoSendUsingPort 2
#Define
cdoAnonymous 0
#Define cdoBasic 1 && clear text
#Define cdoNTLM 2 && NTLM
&& Delivery Status Notifications
#Define cdoDSNDefault 0 &&None
#Define cdoDSNNever 1 && None
#Define cdoDSNFailure 2 && Failure
#Define cdoDSNSuccess 4 && Success
#Define cdoDSNDelay =3D 8 &&De=
lay
#Define cdoDSNSuccessFailOrDelay 14=
&&Success, failure or delay
Local objMsg,objConf,objFlds
Store Null To objMsg,objCo=
nf,objFlds
objMsg =3D Createobject("CDO.Message")
objConf =3D Createobject("CDO.Configuration")
objFlds =3D objConf.Fields
With objFlds
.Item("http://schemas.microsoft.com=
/cdo/configuration/sendusing")
=3D cdoSendUsingPort
.Item("http://schemas.microsoft.com=
/cdo/configuration/smtpserverport")
=3D 2525
.Item=
("=
http://schemas.microsoft.com/cdo/configuration/smtpserver")
=3D "mail.carvertechnologies.com"
.Item("http://schemas.microsoft.com/cdo/configu=
ration/smtpauthenticate")
=3D cdoBasic
.Item("http://schemas.microsoft.com=
/cdo/configuration/sendusername")
=3D "mike.gagnon@carvertechnologies.com"
.Item=
("=
http://schemas.microsoft.com/cdo/configuration/sendpassword")
=3D "moutarde"
.Update
Endwith
strBody =3D "This is a sample message." + CRLF
strBody =3D strBody + "It was sent using CDO." + CRLF
With objMsg
.Configuration =3D objC=
onf
.To =3D "mgagnon23@hotmail.com"<= o:p>
.From =3D "me@my.com"
.Sender =3D 'Me'
.Subject =3D "This=
is a
CDO test message"
.TextBody =3D strBody
&& use .HTMLBody to send HTML email.
*.Addattachment "c:\temp\Scripty.zip"
.Fields("urn:schemas:mailheader:disposition-notification-to") =3D
"me@my.com"
.Fields("urn:schemas:mailheader:return-r=
eceipt-to")
=3D "me@my.com"
.DSNOptions =3D
cdoDSNSuccessFailOrDelay
.Fields.Update=
.Send()
Endwith
Avec la venue de Win=
dows
7, Microsoft a décidé d’inclure le service SMTP avec IIS 7. Qui rend la tâc=
he
d’installer un service SMTP plus difficile.
Voici les étapes&nbs=
p;:
1.
Control panel-Programs and Features-Turn win=
dow
features on or off
2.&n=
bsp;
Cliquez =
sur
les services requis
3.
Control Pannel-administrative tools-Internet
information Services (IIS)
4.
SMTP E-mail
5.
Configuration
L’avantage de config=
urer
un service SMTP est que l’on plus à le refaire et le code utilisée pour CDO
contient moins de lignes.
CDO dans sa première
version, nous permettait de créer des appointments, personne , mais plus
maintenant. C’est seulement disponible avec Exchange Server.
oApp=3D CREATEOBJEC=
T("cdo.appointment")
CDO permet aussi de
créer de documents MHTLM (page web incluant les images en binaire dans la p=
age
web elle-même),
Local
lcFileName,lcStr && Variables locales=
span>
Declare Intege=
r
ShellExecute In "Shell32.dll"
;
INTEGER HWnd=
span>, ;
STRING lpVerb, ;
STRING lpFile, ;
STRING lpParameters, ;
STRING lpDirectory, ;
LONG nShowCmd
lcFileName =3D Sys(2015)+'.mht'
&& Nom du document final
oMSG =3D Createobject("CDO.Message")
&& Message couriel -- strictement pour =
la
fonction suivante
oMSG.CreateMHTMLBody("http://www.microsoft.c=
om")
&& Créer un document MHTML
lcStr =3D oMSG.getstream && Stocker le =
document
dans une variable
lcStr.SaveToFile(lcFileName,2) && Sauve=
garder
le document en MHT.
ShellExecute(0,"Open",lcFileName=
,"","&qu=
ot;,0)
&& Ouvrir avec ShellExecute.
Comment automatiser Outlook av=
ec
FoxPro
L’association AtoutFox attire votre
attention sur le respect du droit français : l'usage de cet exemple de code
peut être illégal en contrevenant au respect du caractère privé de la
correspondance.
Mise en situation :
Notre client nous demande de cré=
er
une piste de vérification pour tous les courriels sortant. C’est une société
canadienne avec de très hautes demandes au niveau de la sécurité. Vu qu’il
n’utilise pas Exchange, nous avons dû trouver un moyen avec Foxpro de
satisfaire la demande de notre client. Cette méthode utilise l’interop
d’Outlook, bindevevents, un DLL de Foxpro et VFPCOM.COMUTIL. Notre client nous a
demande aussi que le tout soit ‘invisible’ à l’utilisateur. Donc nous devio=
ns
utiliser l’interface d’Outlook, plutôt que l’automation.
Notre serveur COM <=
span
class=3Dhps>va agir comme une piste de véri=
fication
pour certains types d'activités<=
/span> dans Outlook.
=
· =
Voici
le code de base pour la première version de notre serveur COM. Il
a une seule méthode publique nom=
mée
WriteLog qui utilise la <=
span
class=3Dhps>fonction STRTOFILE VFP
pour placer des informations dan=
s un
fichier journal.
Define Class OutTrack As Custom OlePublic
=
Name
=3D
"OutTrack"
=
Procedure writelog
=
Lparameters tcInfo
=
If Empty(tcInfo)
=
tcInfo
=3D ""
=
Endif
=
=3DStrtofile(Chr(13)+Chr(10)+Replicate("-",80)+Chr(13)+Chr(10)+" "+Sys(0)+;
=
'
' +Ttoc(Datetime())+' '+Chr(13)+Chr(10)+tcInfo;
=
+Chr(13)+Chr(10),"\OUTLOOK.LOG",.T.)
=
Endproc
Enddefine
Et pour tester ce DLL dans FoxPro, on utilise le
code suivant.
X =3D createobject('Outc=
ome.OutTrack')
x.WriteLog("MA PISTE")
Vous devriez obtenir un résultat comme ceci dans=
un
fichier texte.
MIKEGAGNON-PC # MikeGagnon 04/08/12 10=
:55:12
AM
MA PISTE
·
Ensuite nous devons créer une
application qui va agir en tant qu’interop entre Foxpro et Outlook, pour no=
us
permettre d’intercepter les méthodes d’Outlook.
Pour découvrir quelle méthode nous devons utiliser, on peut
utiliser ‘Object Browser’ dans Foxpro, qui nous permet de voir toutes les m=
éthodes
accessibles. La méthode qui nous intéresse est Items end().
Donc
voici le petit programme qui va interagir avec Outlook pour intercepter les
courriels envoyés depuis un poste et faire appel à notre DLL pour écrire da=
ns
un fichier LOG le contenu du courriel.
#Define VFPCOM_CLSID
'VFPCOM.COMUTIL'
#Define OUTLOOK_CLSID
'OUTLOOK.APPLICATION'
#DEFINE OUTCOME_TRACKER 'OUTCOME.OUTTRACK'
#define CRLF chr(13)+chr(10)
Public goVFPCOM, goOutlook, goLink,goTrack
goVFPCOM =3D Create(VFPCOM_CLSID)
goOutlook =3D Create(OUTLOOK_CLSID)
goTrack =3D createobject(OUTCOME_TRACKER)
goLink =3D Create('OutlookApplicationEvents')
goVFPCOM.BindEvents(goOutlook, goLink)=
read events
Define Class OutlookApplicationEvents As Custom
=
Procedure
ItemSe=
nd(Item,Cancel)
goTrack.WriteLog("Courriel envoye a: "+Item.to+CRLF+ Item.Body)
=
Endproc
Enddefine
Pour le but de l’exercice nous allons seulement utiliser la
méthode ItemSend(). Mais toute autre méthode peut-être aussi utilisée. Donc
nous créons une instance de VFPCOM, d’Outlook et notre DLL.
Donc tous les courriels qui vont être envoyés du poste, vont
être enregistre dans notre fichier Outlook.log, sans que l’utilisateur n’y =
voit
une différence.
P.S.
À la demande du client, nous avons créé un Windows service do programme ci-=
haut
pour qu’il puisse démarrer lorsque l’utilisateur part son ordinateur.
Automatiser OWC (office web
components) avec FoxPro.
Avec la venue de BI
(Business Intelligence), les utilisateurs nous demandent tous des chartes de
toutes les dimensions, couleurs, flexibilité. Qui peuvent être utilisées sur
des formes des rapports etc… Il existe plusieurs outils à notre disposition,
comme MS Graph jusqu’au GDI (FoxCh=
arts
de mon ami César Shalom en est un bon exemple). Chacune de ces méthodes ont
leurs avantages et leurs désavantages. MS Graph est un composant trop simple
pour les besoins réels de BI, mais par contre OWC offre un peu plus de flex=
ibilité.
Premièrement il nous offre de sauvegarder le résultat de la charte en image=
de
plusieurs formats (GIF, JPG, and PNG). On peut aussi créer des char=
tes
tridimensionnelles, changer la luminosité etc...
Un des avantages avec
OWC est comme on le sait tous, ce n’est pas tous les programmeurs dans le m=
onde
de Foxpro qui utilise FoxPro version 9. OWC par contre fonctionne à partir =
de
Foxpro 5. FoxCharts requiert la Foxpro version 9 SP2.
Les Composantes Offi=
ce
Web ont été abandonnées dans Office 2007, et ne sont pas inclus, sauf une
partie d’Office Project Server 2007. [7] Toutefois, ils seront toujours
disponibles pour téléchargement sur le site de Microsoft. Microsoft n'a pas
encore offert un remplacement complet pour les Office Web Components. Donc =
pour
l’instant c’est un activex utilisable pour créer des chartes, tables pivot =
etc…
Vous pouvez trouver le modèle de OWC ici (http://msdn.microsoft.com/en-us/library/aa=
166512(v=3Doffice.10)) et vous pouvez telecharge =
OWC
ici http://www.microsoft.com/en-us/download/details.aspx?id=3D22276
Ce composant nous pe=
rmet
de créer :
· =
Tableur
· =
Chartspace
· =
Table
pivot dynamique.
· =
Composant
de sources de donnees.
Voici un exemple sim=
ple
de créer une charte avec OWC.
*** Data to render
local lcAction,lcFile
DECLARE INTEGER ShellExecute=
IN shell32.dll ;
INTEGER hndWin, ;
STRING cAction, ;
STRING cFileName, ;
STRING cParams, ;
STRING cDir, ;
INTEGER nShowWin
DIMENSION laLabels[3=
]
DIMENSION laData[3]<= o:p>
DIMENSION laData2[3]=
laLabels[1] =3D "Item 1"
laLabels[2] =3D "Item 2"
laLabels[3] =3D "Item 3"
laData[1] =3D 100
laData[2] =3D 255
laData[3] =3D 159
laData2[1] =3D 200
laData2[2] =3D 250
laData2[3] =3D 195
loChartSpace =3D CREATEOBJECT<=
/span>("OWC11.ChartSpace") oConst =3D loChartSpace.Constants loGraph =3D loChartSpace.Charts.Add() loGraph.Type =3D 0 && Column Graph loGraph.HasLegend =3D .T. loGraph.PlotArea.Interior.Color =
=3D "LightYellow" loChartSpace.HasChartSpaceTit=
le =3D
.T. loChartSpace.ChartSpaceTitle.=
Caption =3D
"Données-échantillon" loChartSpace.ChartSpaceTitle.=
Font=
.Bold =3D =
.T. loGraph.SeriesCollection.Add<=
span
style=3D'font-size:10.0pt;font-family:"Courier New";color:black'>() loGraph.SeriesCollection(0).<=
/span>Caption =3D "=
Legende
Series 1" loGraph.SeriesCollection(0).<=
/span>SetData(oConst.ch=
DimCategories,
oConst.chDataLiteral, @laLabels) loGraph.SeriesCollection(0).<=
/span>SetData(oConst.ch=
DimValues,
oConst.chDataLiteral, @laData) loGraph.SeriesCollection.Add<=
span
style=3D'font-size:10.0pt;font-family:"Courier New";color:black'>() loGraph.SeriesCollection(1).<=
/span>Caption =3D "=
Legende
Series 2" loGraph.SeriesCollection(1).<=
/span>SetData(oConst.ch=
DimValues,
oConst.chDataLiteral, @laData2) lcFile =3D SYS(2023) + "\" + SYS
loChartSpace.ExportPicture(lcFile, "gif",;
=
span>640,400)
cAction =3D "open"<= o:p>
ShellExecute(0,cAction,lcFile=
,"","",1)
Qui
nous donne un charte comme ceci.
ky
Automatiser Skype avec FoxPr=
o.
Avec la venue de Sky=
pe
et VoIP (voice-over-IP), la téléphonie a changée et il est maintenant possi=
ble
de faire des appels téléphoniques ‘gratuitement’ avec ce type d’outil.
Pour pouvoir automat=
iser
Skype il nous faut 2 choses. Skype lui-meme et un dll appele Skype4Com.dll.=
On
peut trouver la plus recente version de Skype ici http://www.skype.com/intl/en/get-skype/on-=
your-computer/windows/downloading
et Skype4Com.dll
ici
1. Pour placer un appel (message
test) avec skype et foxpro.
Public oform1
oform1=
=3DNewobject(&quo=
t;form1")
oform1.Show
Return
Define Class form1 As Form
DoCreate =
span>=3D .T.
Caption =3D "=
Essai de
Skype"
skypeaccount =3D "your skype account"
oleskype =3D "null=
"
ocall =3D "null&qu=
ot;
Name =3D "Form1"
Add Object text1 As TextBox With ;
Value =3D "echo123", ;
Height =3D 25, ;
Left =3D 144, ;
Top =3D 66, ;
Width =3D 157, ;
Name =3D "Text1"
Add Object label1 As Label With ;
AutoSize =3D .T., ;
Caption =3D "Number to
call", ;
Height =3D 17, ;
Left =3D 48, ;
Top =3D 68, ;
Width =3D 82, ;
Name =3D "Label1"
Add Object commandgroup1
AutoSize =3D .F., ;
ButtonCount =3D 2, ;
BorderStyle =3D 0, ;
Value =3D 1, ;
Height =3D 37, ;
Left =3D 110, ;
Top =3D 144, ;
Width =3D 154, ;
Name =3D "Commandgroup1", ;
Command1.AutoSize =3D .=
F., ;
Command1.Top =3D 5, ;
Command1.Left =3D 5, ;
Command1.Height =3D 27, ;
Command1.Width =3D 71, ;
Command1.Caption =3D "Pl=
ace
call", ;
Command1.Name =3D
"Command1", ;
Command2.AutoSize =3D .=
F., ;
Command2.Top =3D 5, ;
Command2.Left =3D 78, ;
Command2.Height =3D 27, ;
Command2.Width =3D 71, ;
Command2.Caption =3D "End
call", ;
Command2.Name =3D
"Command2"
Procedure Init
Thisform.oleskype =3D Create=
object("Skype4COM.Skype", "Skype")
If Thisform.oleskype.Client.IsRunni=
ng
Messagebox(&quo=
t;Skype
is already started ")
Thisform.oleskype.=
span>User(Thisform.skypeaccoun=
t)
Else
Messagebox=
("You have to start Skype")
Return
Endif
Thisform.oleskype.Attach=
()
Endproc
Procedure commandgroup1.Command1.Click
Try
Thisform.ocall =3D Thisfo=
rm.oleskype.PlaceCall(Thisform.text1.Value)
Catch To loerror
Endtry
Endproc
Procedure commandgroup1.Command2.Click
Thisform.ocall.fin=
ish()
Endproc
Enddefine
2.&n=
bsp;
Comment envoyer un message S=
MS
avec Skype
<=
span
lang=3DEN-US style=3D'font-size:10.0pt;font-family:"Courier New";color:blue;
mso-ansi-language:EN-US'>LOCAL loSkype as skype4com.sk=
ype,
lcPhoneNr as String, lcMessage as String, lnStatus as num=
ber
lnStatus =3D 0
loSkype =3D CreateObject("Skype4COM.Skype", "Skype_")<= o:p>
lcPhoneNr =3D "+15146913876"
lcMessage =3D "this is a test"
If Not loSkype.Client.IsRunning Then
do while Not loSkype.Client.IsRunning
loSkype.Client.Start()=
enddo
EndIf
loSkype.SendSms( lcPhoneNr, lcMessage)
INKEY(.5)
?loSkype.Convert.SmsMessageStatusToText(lnStatus)
Trucs et astuces.
=
Foxpro
VS SQL.
3.&n=
bsp;
Nous avons un logiciel de
ressources humaines et paie qui est développer en Visual Foxpro, et qui peux
rouler avec des tables Foxpro ou MSSQL ou Oracle.
Une des problèmes qui arrive souvent est que le code qu’un
programmeur habitue à programmer en FoxPro font des erreurs de programmation
très simples, qui fonctionne correctement en FoxPro mais lorsque que l’on
change de base de données, et que l’on utilise SQL par exemple ces erreurs =
sont
inacceptables. Il est donc suggérer de test votre code avec les deux
environnements avec de livrer à votre client, comme cela vous n’aurez pas de
surprises désagréables.
En voici quelques exemples.
Dans Foxpro ont peux utiliser ceci sans problème :
select * from pers where
e_persid =3D> 1000 Mais lorsque vous lorsque vous vous retournez vers une base =
de données
SQL et testez le même code, vous allez obtenir le message d’erreur
suivant : Msg 102, Level 15, State 1, Line =
1 Incorrect syntax near '>'. Vu que Foxpro accepte soit : select * from pers where
e_persid =3D>
1000 Ou select * from pers where
e_persid <=3D
1000 Et que SQL n’accepte que select<=
span
style=3D'font-size:10.0pt;line-height:115%;mso-bidi-font-family:Calibri;
mso-bidi-theme-font:minor-latin;mso-no-proof:yes'> *
from pers wher=
e
e_persid <=3D
1000
La conclusion est d’utiliser la deuxième requete, pour que
les deux environnements fonctionne correctement. Il est toujours bon de tes=
ter
les deux environnements.
4.
La fonction EMPTY()
Pour tester un champs vide tout le monde connait la fonct=
ion
EMPTY(), mais cette fonction peut cree des problèmes lorsqu’on l’utilise su=
r un
base de donnees SQL sur un champs varchar (champs Memo dans Foxpro. Par exe=
mple
avec Foxpro si on veux determiner si un champs memo est vide un peux utilis=
er
ceci sans problème :
select
qJobhist
if
empty(qJobhist.h_champsmemo) && .T.
Mais quand vient le temps de creer un curseur d’une table=
SQL
(avec le meme champs Varchar), Foxpro dans notre requete nous retourne un
champs memo du meme champs, mais tout d’un coup le code ne fonctionne
plus :
select qJobhist
if empty(qJobhist.h_champsmemo) && .F.
Et pourquoi? Parce qu’en fait il n’est techniquement pas vide,=
il
y s’y trouve un caractère (invisible) qui rendu la vérification à fausse. D=
onc
une des solutions est ceci (il y a plusieurs autres, mais moi j’utili=
se
celle-ci) :
if empty(qJobhist.h_champsmemo+'') && .T.
Qui me donne la bonne réponse, dans les deux environnements (S=
QL
et Foxpro). Je répète tester votre code dans les deux environnements.
5.=
=
Comm=
ent
montrer la calculatrice de Windows à l’intérieure de votre application. Un
vieux truc mais toujours bon à savoir :
#Define SW_SHOWNORMAL 1
Declare Integer GetActiveWindow
Declare Integer GetDesktopWindow In user32
Declare Integer FindWindow In user32;
STRING lpClassName, String lpWindowName
Declare Integer WinExec In kernel32;
STRING lpCmdLine, Integer nCmdShow
Declare Integer SetParent In user32;
INTEGER hWndChild, Integer hWndNewParent
Local hCalc
Do While .T.
hCalc =3D FindWindow (.Null., "Calculator&quo=
t;)
If hCalc =3D 0
=3D WinExec ("calc.exe",
SW_SHOWNORMAL)
Else
=
Exit
Endif
Enddo
6.=
=
Comm=
ent
créer une forme ronde (pour un mot de passe par exemple et on peut y mettre=
une
image de fonds comme le logo de la société de votre client).
Declare
Integer GetFocus
In user32 Declare
Integer DeleteObject
In gdi32 Integer hObject Declare
Integer GetSystemMetrics
In user32 Integer nIndex Declare
Integer ReleaseCapture
In user32 Declare
Integer SendMessage
In user32; INTEGER
HWnd, Integer Msg,; INTEGER
wParam=
, Integer Lparam Declare
Integer CreateEllipticRgn
In gdi32; INTEGER
nLeftR=
ect,
Integer=
nTopRect,; INTEGER
nRight=
Rect,
Integer=
nBottomRect Declare
Integer SetWindowRgn
In user32; INTEGER
HWnd, Integer hRgn, Integer bRedraw Public
frm frm
=3D Createo=
bject
("=
;myform") frm.Visible =3D .T. Define
Class Myform
As Form=
#Define badgeDiameter 264 #Define topMargin 4 #Define leftMargin 2 Width =3D 300 Height =3D 350 AutoCenter =3D .T. hRgn=3D0 Add Object lbl As Label With; Caption=3D"Votre mot de passe:", FontName=3D"Arial", Fo=
ntSize=3D14,; Bold=3D.T., ForeColor=3DRgb(0,0,0), BackStyle=3D0,; Alignment=3D2, Left=3D45, Width=3D200, Top=3D105, Height=3D25 Add Object txt As TextBox With; Width=3D100, Height=3D24, Left=3D82, Top=3D130,; PasswordChar=3D"*" Add Object cmd As CommandButton With; Width=3D60, Height=3D25, Left=3D104, Top=3D165,; Caption=3D"Ok", Default=3D.T. Procedure Activate This.RegionOn Procedure RegionOn #Define SM_CYSIZE
31 #Define SM_CXFRAME 32 #Define SM_CYFRAME 33 If This.hRgn <> 0 Return && the region is already set Endif Local HWnd, x0, y0, x1, y1 x0 =3D GetSystemMetrics
(SM_CXFRAME) + leftMargin y0 =3D GetSystemMetrics (SM=
_CYSIZE)
+; GetSystemMetrics (SM_CYFRAM=
E) +
topMargin x1 =3D x0 + badgeDiameter y1 =3D y0 + badgeDiameter This.hRgn =3D CreateEllipticRgn (x0, y0, x=
1, y1) HWnd =3D GetFocus() If SetWindowRgn (HWnd, This.hRgn, 1) =3D 0 =3D DeleteO=
bject (This.hRgn) This.hRgn =3D 0 Endif ***
---------------------------- Endproc Procedure MouseDown Lparameters nButton, nShift, nXCoord,
nYCoord #Define WM_NULL 0 #Define WM_SYSCOMMAND 274 =
&& 0x112 #Define MOUSE_MOVE
61458 && 0xF012 If nButton =3D 1 =3D
ReleaseCapture() =3D SendMes=
sage
(GetFocus(), WM_SYSCOMMAND, MOUSE_MOVE, WM_NULL) Endif Procedure cmd.Click Thisform.Release Enddefine 7.=
=
Comm=
ent
forcer un courriel de quitter le ‘outbox’ d’Outlook. Dans certain cas le
courriel ne veux pas se faire envoyer. =
oOutlook =3D GETOBJECT(,"Outlook.Applicatio=
n") =
span> oNameSpace=3D
oOutlook.GetNamespace("MAPI") =
span> oFolder
=3D oNameSpace.GetDefaultfolder(4) =
span> oSend
=3D oFolder.Items(1).Send <=
/span> 8.&n=
bsp;
Comment cr=
eer
un GUID. *
-- returns a Globally Unique IDentifier (GUID) local
cData1,
cData2, cData3, cData4, cData5, cDataAll private
PGuid<=
o:p> store
"=
"
to cData1, cData2, cData3, cD=
ata4,
cData5, cDataAll *
-- declare external function DECLARE
INTEGER CoCreateGuid
IN OLE32.DLL STRING @pGuid *
-- Initialize the buffer that will hold the GUID with nulls pGuid
=3D REPLICA=
TE(CHR(0),17) *
-- Call CoCreateGuid IF CoCreateGuid(@pGuid) =3D 0=
&& success * -- Store the first eight characters =
of the
GUID in data1 cData1 =3D RIGHT(TRANSFORM(strtolong(LEFT(pGuid,4)),"@0"),8) * -- Store the first group of four characters of t=
he
GUID in data2 cData2 =3D RIGHT(TRANSFORM(strtolong(SUBSTR(pGuid,5,2)),"@0"),4) * -- Store the second group of four characters of =
the
GUID in data3 cData3 =3D RIGHT(TRANSFORM(strtolong(SUBSTR(pGuid,7,2)),"@0"),4) * -- Store the third group of four characters of t=
he
GUID in data4 cData4 =3D RIGHT(TRANSFORM(strtolong(SUBSTR(pGuid,9,1)),"@0"),2) + ; RIGHT(TRANSFORM(strtolong(SUBSTR(pGuid,10,1)),"@0"),2) * -- Initialize data5 to a null string cData5 =3D "" * -- Convert the final 12 characters of the GUID a=
nd
store in data5 FOR nGuidLen =3D 1 TO 6 cData5=3DcData5+RIGHT(TRANSFORM(strtolong(SUBSTR(pGuid,10+nGuidLen,1))),2) ENDFOR * -- Check the length of data5. If less than 12, t=
he
final 12-len(data5) * -- characters are '0' IF LEN(cData5) < 12 cData5=3DcData5+REPLICATE("0",12-LEN(cData5)) ENDIF * -- Assemble the GUID into a string cDataAll =3D
cData1+"-"+cData2+"-"+cData3+"-"+cData4+"=
;-"+cData5 ENDIF *
-- Done with the call to CoCreateGuid, so clear the DLLs from memory CLEAR
DLLS ?
cDataAll ******************* FUNCTION
strtol=
ong *
-- Passed: 4-byte character string
(lcLongstr) in low-high ASCII format *
-- Returns: long integer value *
-- Example: *
-- m.longstr =3D "1111" *
-- m.longval =3D strtolong(m.longstr) PARAMETERS
lcLong=
str LOCAL
lnByte,
lnRetval lnRetval
=3D 0 FOR
lnByte=
=3D 0
TO 24 STEP 8 lnRetval =3D lnRetval + (ASC(lcLongstr) * (2^lnByte)) lcLongstr =3D RIGHT(lcLongstr, LEN(lcLongstr) - 1) NEXT RETURN lnRetval 9. &n=
bsp;
Comment éteindre un ordinateur
(toute versions jusqu’à Windows 7) shutdownwin(.t.,.t.) procedure
shutdo=
wnwin
LPARAMETERS
tlShut=
downRequested,
tlInteractiveShutdown #DEFINE SE_SHUTDOWN_NAME
"SeShutdownPrivilege" <=
/span>&& Privilege to sh=
ut
down windows #DEFINE SE_PRIVILEGE_ENABLED 2 && Enable privilege flag #DEFINE TOKEN_QUERY 2 && Token may query
status #DEFINE TOKEN_ADJUST_PRIVILEGE 0x20 && Token may adjust privileges=
#DEFINE EWX_SHUTDOWN 1 #DEFINE EWX_REBOOT 2 && Initiate a rebo=
ot #DEFINE EWX_FORCE 4 && Force processes=
to
close #DEFINE SIZEOFTOKENPRIVILEGE 16 * Windows Shutdown API - all platforms DECLARE
ExitWi=
ndowsEx
IN WIN32API INTEGER uFlags, INTEGER dwReserved && API call to shut
down Windows * Check the OS to see if we need to reque=
st the
privilege IF ('4.0' $ OS() OR '5.0' $ OS() OR 'NT' $ OS()) OR '6=
.0' $ OS() * API Cal=
ls
below are NT/2K specific or only needed to manipulate process permissions *
Retrieve the LUID of a specific privilege name - changes each time
Windows restarts DECLARE SHORT LookupPrivilegeValue IN ADVAPI32 ; INTEGER lpSystemName, ; STRING @ lpPrivilegeName, ; STRING @ pluid * Get an =
hToken
with specific permission sets for a given process handle DECLARE SHORT OpenProcessToken IN Win32API ; INTEGER hProcess, ; INTEGER dwDesiredAccess, ; INTEGER @ TokenHandle * Alter t=
he
privileges granted to a Process via a specific hToken DECLARE INTEGER AdjustTokenPrivileges IN ADVAPI32 ; INTEGER hToken, ; INTEGER bDisableAllPrivileges, ; STRING @ NewState, ; INTEGER dwBufferLen, ; INTEGER PreviousState, ; INTEGER @ pReturnLength * Get the
Process handle for this process DECLARE INTEGER GetCurrentProcess IN WIN32API LOCAL cLUID, nhToken, cTokenPrivs, nFlag cLUID =3D REPL(CHR(0),8) =
span>&& 64 bit Locally
Unique IDentifier for the Privilege IF LookupPrivilegeValue(0, SE_SHUTDOWN_NAME, @cLUID) =
=3D 0 RETURN .F. && Privilege not defined for this process<=
o:p> ENDIF nhToken =3D 0 =
span>&& Process Token to be used to manipulate
process privilege set IF OpenProcessToken(GetCurrentProcess(), TOKEN_QUERY +
TOKEN_ADJUST_PRIVILEGE , @nhToken) =3D 0 RETURN .F. && OS will not grant handle with necessary
rights ENDIF * Create a
TOKEN_PRIVILEGES structure, a 4 byte DWORD indicating # permissions, *
followed by an array of 8 byte LUIDs and the 4 byte DWORD permission
attributes * =
span>for
it. One privilege, the LUID retrie=
ved
for shutdown, enable attribute set cTokenPrivs =3D CHR(1) + REPL(CHR(0),3) + cLUID + CHR(SE_PRIVILEGE_ENABLED) + REPL(CHR(0), 3) IF AdjustTokenPrivileges(nhToken, 0, @cTokenPrivs,
SIZEOFTOKENPRIVILEGE, 0, 0) =3D 0 RETURN .F. && Privilege denie=
d ENDIF ENDIF CLOSE
ALL &&
Start shutting down VFP tables FLUSH &&
Suggest that the OS flush all buffers CLEAR
EVENTS && Avoid VFP being obstinate ON
SHUTDOWN &&
don't try to run anything extra * Select shutdown flags DO
CASE CASE
tlShut=
downRequested
AND tlInteractiveShutdown nFlag =3D EWX_SHUTDOWN CASE
tlShut=
downRequested nFlag =3D EWX_SHUTDOWN + EWX_FORCE CASE
tlInte=
ractiveShutdown nFlag =3D EWX_REBOOT OTHERWISE nFlag =3D EWX_REBOOT + EWX_FORCE ENDCASE =3DExitWindowsEx(nFlag,
0) && Force a reboot to be initia=
ted QUIT &&
Start an orderly shutdown of VFP Mais
lorsque l’on copie le même texte d’un document Word par exemple, on obtient
plusieurs autres formats. Comme RTF et HTML. =
On
pourrait par exemple copier un document Word que l’on veut sauvegarder en <=
o:p> En document RTF. Avec le curseur ci-haut on n’a qu’à prendre
l’information du champ Fmtdata et utiliser STRTOFILE() vers un document RTF=
. Voici un autre exemple qui démontre la technique. Extendedcliptext.prg 11=
. Comm=
ent
convertir une image en un icone. Avec=
les
API de GDI il a facile de produire un icone à partir d’une image. Imag=
etoicon.prg
Resu=
ltat
testicon.ico 12=
. La l=
ecture
de la mémoire partagée. Voic=
i un
exemple comment passer de l’information d’une application à une autre en
etablissant une mémoire partagée acessible des deux applications. (rou=
ler le
meme prg dans deux instances de foxpro) Shar=
edmemory.prg 13=
. Comm=
ent
encrypter et decrypter un fichier texte. Voici
comment encrypter un fichier texte et le decryter. La c=
lasse
utilise plusieurs fonctions EncryptDecrypt API de cryptographie à mettre en=
œuvre
protégé par mot de passe et le décryptage des fichiers. Encr=
ypttext.prg 14=
. Comm=
ent
dectecter un ajout d’un ficher dans un repertoire. Dire=
ctorychanges.prg 15=
. Comm=
ent
créer un windows service avec Foxpro. Pour=
créer
un windows service il nous faut 3 choses. ·&nb=
sp;
Une entree dans la base de registre, qui p=
ointe
vers l’executable. ·&nb=
sp;
Instsrv.exe et srvany.exe (qui font parti =
de
Windows SDK). Le premier installe le service et le deuxième roule le servic=
e. ·&nb=
sp;
Et finallement notre service lui-meme
(executable Foxpro). a)=
Crée=
r un
fichier .reg avec queleque chose comme ceci. Windows Registry Editor Version 5.00 [HKEY_LOCAL_MACHIN=
E\SYSTEM\CurrentControlSet\Services\SymcodService\Parameters] "AppDirectory"=3D"C=
:\\symcodservice" "Application"=3D"C:=
\\symcodservice\\SymcodService.exe" "AppParameters"=3D"=
myparm1
myparm2" Les deux parametres peuvent par exemple le chemin du fichier i=
ni. Et
le deuxième peut-etre le programme que l’on veut rouler. b)=
Pour
installer le service nous avons qu’utiliser la ligne de commande
suivante : C:\Program Files\Windows Resource Kits\Tools>instsrv SymcodService
"d:\Program Files\Windows Resource Kits\Tools\srvany.exe" Le programme srvany.exe =
doit
rester dans le repertoire de l’application, puisque c’est lui qui va indiqu=
er
au service quel executable rouler, en lisant la base de registre. On peut confirmer que le
service est bien installe en consultant le panneu de service. Vous remarquerez que le service pointe v=
ers
srvany.exe et non vers le service lui-meme, puisque la base de registre con=
tient
l’information. c)=
=
Notre
executable est bien simple, Il prend le parametre de la base de registre est
excecute le programme indique. * Program...........: service.pr=
g * Author............: Mike Gagno=
n * Project...........: Carver Hum=
an Resources * Created...........: June 17, 2=
012 * Code page.........: 1252 (WIND=
OWS) * Copyright.........: (c) Carver
Technologies Inc. 2012 * Description.......: Start up
program for a sevice (symcodservice or others) * &=
nbsp; &nbs=
p;
: This is to replace the symcod watcher application * &=
nbsp; &nbs=
p;
: But can be used to start other services. * Classes...........: None * &=
nbsp; &nbs=
p;
: * &=
nbsp; &nbs=
p;
: * &=
nbsp; &nbs=
p;
: Lparameters tcInifile,tcProgram #Define EVENT_SUCCES=
S
0 local oService, loShell oService =3D null on shutdown myShutDown() oService=3DNewobject("vfpsrv",'','',tcInifile,tcProgram) &&& create the service with thee
parameters *** from the windows registry oService.logstr("Starting Service:
got some params: "+Transform(tcProgram)+' '+Transform(tcInifile)) *** A windows event log to record the
success of the service start. loShell =3D Createobject("Wscript.Shell") loShell.LogEvent(EVENT_SUCCESS,"S=
ymcod
service est parti avec succès. "+Ttoc(Datetime())) Read Events &nbs=
p;
&& message loop<=
o:p> *#####################################=
#################### Define Class vfpsrv As
custom *#####################################=
#################### *=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D Procedure Init &nb=
sp;
Lparameters tcInifile,
tcProgram &n=
bsp;
This.logstr(Curdir()) &n=
bsp;
This.logstr(tcInifile+' '+tcProgram) &n=
bsp;
*** Run the program that=
was
sent as a parameter &n=
bsp;
Do &tcProgram With tcInifile endproc *=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D Procedure logstr(Str
As String) *** write to a log to confirm the service has star=
ted.
=
Str=3DTransform(Datetime())+&qu=
ot;
"+Str =
Strtofile(Str,"c:\vfpsrv.log",.T.) Endproc *#####################################=
#################### Enddefine *=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D Procedure MyShutdown =
Clear
Events
Quit Endproc Comm=
e cela
on peut utiliser ce service pour partir n’importe quelle application. Une =
chose
à noter le service ne permet aucune interface (forme, wait windows, message=
box
etc…) Voic=
i un
example qui est fonctionnel…. <=
o:p> <=
o:p>