PureBasic

Forums PureBasic - Français
http://forums.purebasic.com/french/

Conversion d'un code en Delphi.

http://forums.purebasic.com/french/viewtopic.php?t=12542

Page 2 sur 2

Re: Conversion d'un code en Delphi.

Publié : jeu. 02/févr./2012 17:35
par djes
Fais un messagerequester sur SetShareData(2, Count) pour savoir quelle est la valeur renvoyée (doit être <> de 0)

Re: Conversion d'un code en Delphi.

Publié : jeu. 02/févr./2012 18:39
par GallyHC
La valeur est de "46989320" donc bien <> 0

Re: Conversion d'un code en Delphi.

Publié : ven. 03/févr./2012 10:12
par GallyHC
Bonjour,

Je ne vois pas pourquoi cela ne fonctionne pas avec cette fonction vu que visiblement le reste fonctionne?

Cordialement,
GallyHC

Re: Conversion d'un code en Delphi.

Publié : ven. 03/févr./2012 18:23
par Mesa
Voici, quelques pistes de réflexions.

procedure SetShareData (address,data: Longint);
var p:pointer;
ret:longint;
begin
p:=ShareData;
asm
push edi
mov edi,p
add edi,address
add edi,address
add edi,address
add edi,address
mov ret,edi
mov eax,data
mov ds:[edi],eax
pop edi
end;
end;

function GetShareData (Address:Longint): Longint; stdcall;
var p:pointer;
k:longint;
begin
p:= ShareData;
asm
push edi
mov edi,p
add edi,address
add edi,address
add edi,address
add edi,address
mov eax,ds:[edi]
mov k,eax
pop edi
end;
Result:=k;
end;

Sauf erreur, car ça fait longtemps que je n'ai pas programmé en Delphi:

Une procedure ne renvoie pas de donnée alors que function en renvoie une.

Longint est fixé à 32 bits que ce soit avec un OS 32b ou 64b.

Un pointeur est déclaré avec un accent circonflexe mais s'utilise sans.
.Pointer permet de déclarer un pointeur non typé.

Les convention d'appel (ordre dans lequel les variables sont passées) d'une procedure ou d'une fonction se font selon différentes directives : register, pascal, cdecl, stdcall et safecall
La directive cdecl est utile pour les DLLs écrites en C ou C++ alors que stdcall et safecall sont plutôt utilisées avec l'API Windows API.
stdcall pour que la DLL puisse être utilisée "plus facilement" avec n'importe quel langage.
// global DLL data
;ShareData: ^longint; // shared
;Problème ici car un pointeur en PureBasic, d'après la doc, n'a pas la même taille sur un OS 32b ou 64b alors que le code assembleur ci-dessous réclame un taille 32b = longint).
Il ne faut donc pas utiliser de pointeur pour ShareData (à mon avis).

Code : Tout sélectionner

ShareData.l=0 ;32b, c'est ok

Code : Tout sélectionner

Procedure.l GetShareData (Address.l) ;(procedureC.l ?, à vérifier )
; .l = toujours 32bits
   k.l=0
   p.l= ShareData;
 
    ;push  edi; sauvegarde edi
   ; Edi=p; mov   edi,p
   ; Edi= edi + address;add   edi,address
   ; Edi= edi + address; add   edi,address
   ;Edi= edi + address;add   edi,address
   ;Edi= edi + address;add   edi,address
   ;ici edi = p=sharedata + 4*address    
   ; transfert de la donné qui est à l'adresse contenue dans edi vers eax;mov   eax,ds:[edi]
   K=peekL(p); mov   k,eax; puis tranfert dans k
   ; pop   edi
  end;
  Returnprocedure k;
endprocedure

Code : Tout sélectionner

procedure SetShareData (address.l,data.l) ;(procedureC ?)

 ret.l=0
 p.l=ShareData;
 
   ; push  edi
    ;mov   edi,p
   ; add   edi,address
    ;add   edi,address
    ;add   edi,address
    ;add   edi,address
P=sharedata + 4*address
Ret=p ;mov   ret,edi
   ; mov   eax,data
   pokeL(ret,data) ;mov   ds:[edi],eax
    ;pop   edi

EndProcedure

Code : Tout sélectionner

ProcedureDLL AttachProcess(Instance)
  
  hMapFile = CreateFileMapping_($FFFFFFFF, #Null, #PAGE_READWRITE, 0, DataSize, VirtualFileName)
  If hMapFile = 0
    MessageRequester("Error", "Error creating memory mapped file", #PB_MessageRequester_Ok)
    End
  Else
;pas de pointeur
    ShareData = MapViewOfFile_(hMapFile, #FILE_MAP_WRITE, 0, 0, DataSize)
    If ShareData = 0
      MessageRequester("Error", "Error creating memory mapped file", #PB_MessageRequester_Ok)
    EndIf
  EndIf

EndProcedure
Voilà, à essayer.

Mesa.

Re: Conversion d'un code en Delphi.

Publié : ven. 03/févr./2012 19:04
par djes
J'ai modifié, ça devrait être bon, là.

Re: Conversion d'un code en Delphi.

Publié : sam. 04/févr./2012 12:12
par GallyHC
Bonjour et merci a toi aussi Mesa

Bon la y a du mieu plus de plantage par contre le boitier ne repond pas au demande je recherche le probleme

Merci,
GallyHC

Re: Conversion d'un code en Delphi.

Publié : sam. 04/févr./2012 14:20
par djes
J'ai changé la façon de lancer l'exe, c'est ptet ça...

Re: Conversion d'un code en Delphi.

Publié : lun. 19/mars/2012 16:31
par GallyHC
Bonjour tous,

Pour commencer déjà un grand merci à Djes (un plus grand Merci) et Mesa pour votre aide.

Je ne savais pas pourquoi cela ne fonctionner pas et l’erreur été toute bête. Le fonction d’envois ne porte pas le même nom que la fonction de la Dll de base alors forcement cela ne pouvait pas fonctionne dans un appel a cette nouvelle lib :)

Au moins j’aurais appris à comprendre l’assembler, car j’ai cherche le pourquoi du comment et avec votre aide voila le code de la Dll qui fonctionne :

J'ai ajouter en fait une fontion pour etre sur qu'un module Velleman VM116 soit présent (aussi appelé 8062 juste a cause de son PID, je l'ai decouvert dans mes recherches).

Code : Tout sélectionner

; +======================================================+
; |      LIBRAIRIE DU CONTROLEUR VM116 DE VELLEMAN       |
; +------------------------------------------------------+
; | COPYRIGHT(C)2007-2012, ALL RIGHT RESERVED KOAKDESIGN |
; +--------------+---------------------------------------+
; | Program type | PUREBASIC 4.60                        |
; +--------------+---------------------------------------+
; | VER & REV    | 0.0.1 RC0                             |
; +--------------+---------------------------------------+
; | Program name | main.pb                               |
; +======================================================+

; +======================================================+
; | Original Version: 0.0.1 RC0                          |
; +--------------+---------------------------------------+
; | Created by   | GallyHomeCorp                         |
; | Graphix by   |                                       |
; +--------------+---------------------------------------+
; | Comments:    |                                       |
; +--------------+                                       |
; |                                                      |
; |                                                      |
; |                                                      |
; +======================================================+

; +======================================================+
; | Système d'Exploitation                               |
; +--------------+---------------------------------------+
; | Window       | Oui                                   |
; | Linux        | Non                                   |
; | MacOS        | Non                                   |
; +======================================================+

; ****************************************************************************
; ****************************************************************************
; ****************************************************************************
; ****************************************************************************

; +--------------------------------------------------------------------------+
; |                                                                          |
; +--------------------------------------------------------------------------+
;- INITIALISATION DES DIRECTIVES COMPILEUR.

DisableASM
EnableExplicit

; ****************************************************************************
; ****************************************************************************
; ****************************************************************************
; ****************************************************************************

; +--------------------------------------------------------------------------+
; |                                                                          |
; +--------------------------------------------------------------------------+
;- DECLARATION DES VARIABLES (VERSION).

;{ - GLOBAL VERSION
#Version = "0.0.1"
#SubVers = ""
#VerDate = "01/12/2011"
Global FullVer.s
Global FullName.s = "K8062DM Library"
Global FullInfo.s = "K8062DM Library for Vellaman VM116 in PureBasic"
Global FilePath.s
If #SubVers = #NULL$
  FullVer = #Version
Else
  FullVer = #Version + "-" + #SubVers
EndIf
;}

; ****************************************************************************
; ****************************************************************************
; ****************************************************************************
; ****************************************************************************

; +--------------------------------------------------------------------------+
; |                                                                          |
; +--------------------------------------------------------------------------+
;- DECLARATION DES PROCEDURES DE LA DLL.

Declare AttachProcess(Instance.i)
Declare DetachProcess(Instance.i)
Declare AttachThread(Instance.i)
Declare DetachThread(Instance.i)

Declare.s setCutLigneVendor(value.s)
Declare.s setCutLigneHID(value.s)
Declare.b GetFoundVM116_8062()

Declare.b StartDevice()
Declare.b StopDevice()
Declare.b SetChannelCount(count.l)
Declare.b SetData(channel.l, ldata.l)
Declare.l GetShareData(address.l)
Declare SetShareData(address.l, ldata.l)

; ****************************************************************************
; ****************************************************************************
; ****************************************************************************
; ****************************************************************************

; +--------------------------------------------------------------------------+
; |                                                                          |
; +--------------------------------------------------------------------------+
;- DECLARATION DES VARIABLES (GLOBALE).

Structure SP_DEVINFO_DATA
  cbSize.l
  ClassGuid.GUID
  DevInst.l
  Reserved.l
EndStructure

Global *ShareData.i
Global hMapFile.l
Global running.b           = #False
Global DataSize.l          = 2500
Global VirtualFileName.s   = "ShareK8062Data"  

#VELLEMAN_INITOK            = $0
#VELLEMAN_NOTFOUND          = -1
#VELLEMAN_ERROR             = -2

; ****************************************************************************
; ****************************************************************************
; ****************************************************************************
; ****************************************************************************

; +--------------------------------------------------------------------------+
; |                                                                          |
; +--------------------------------------------------------------------------+

ProcedureDLL.s DllName()
; DONNE LE NOM DE LA LIBRAIRIE.
  ProcedureReturn FullName

EndProcedure

ProcedureDLL.s DllInformation()
; DONNE LES INFORMATIONS DE LA LIBRAIRIE.
  ProcedureReturn FullInfo

EndProcedure

ProcedureDLL.s DllVerion()
; DONNE LA VERSION DE LA LIBRAIRIE.
  ProcedureReturn FullVer

EndProcedure

ProcedureDLL.s DllDate()
; DONNE LA DATE DE LA LIBRAIRIE.
  ProcedureReturn #VerDate

EndProcedure

; ****************************************************************************
; ****************************************************************************
; ****************************************************************************
; ****************************************************************************

; +--------------------------------------------------------------------------+
; |                                                                          |
; +--------------------------------------------------------------------------+

Procedure.s setCutLigneVendor(value.s)
; ROUTINE DE DECOUPAGE DES REPERTOIRES.
  Define i.l
  Define j.l = 0

  For i=0 To Len(value) - 1 Step 1
    If Mid(value, i, 1) = "&"
      j = i - 1
      Break
    EndIf
  Next i
  If j > 0
    ProcedureReturn Mid(value, 1, j)
  EndIf

EndProcedure

Procedure.b GetFoundVM116_8062()
; ROUTINE DE RECHERCHE DES CONTROLEURS 8062.
  Define value.l
  Define usbid.s
  Define dwReqLen.l
  Define strBuffer.s
  Define RegDataType.l
  Define bresu.b = #False
  
  Define idlib.l          = OpenLibrary(#PB_Any, "cfgmgr32.dll")
  Define ielib.l          = OpenLibrary(#PB_Any, "setupapi.dll")
  CompilerIf #PB_Compiler_Unicode
        Define devic.l    = GetFunction(idlib,   "CM_Get_Device_IDW")
        Define devid.l    = GetFunction(ielib,   "SetupDiGetDeviceRegistryPropertyW")
  CompilerElse
        Define devic.l    = GetFunction(idlib,   "CM_Get_Device_IDA")
        Define devid.l    = GetFunction(ielib,   "SetupDiGetDeviceRegistryPropertyA")
  CompilerEndIf
  Define hDeviceInfoSet.l =  SetupDiGetClassDevs_(0, 0, 0, #DIGCF_PRESENT | #DIGCF_ALLCLASSES)
  Define DeviceInfoData.SP_DEVINFO_DATA : DeviceInfoData\cbSize    = SizeOf(DeviceInfoData)
  
  If hDeviceInfoSet <> #INVALID_HANDLE_VALUE
    While SetupDiEnumDeviceInfo_(hDeviceInfoSet, value, @DeviceInfoData)
      usbid = Space(255)
      CallFunctionFast(devic, DeviceInfoData\DevInst, @usbid, Len(usbid), 0)      
      If LCase(Left(usbid, 3)) = "usb" And FindString(LCase(usbid) ,"pid_8062")
        strBuffer = setCutLigneVendor(Mid(usbid, 5, Len(usbid) - 6 ))
        If CountString(strBuffer, "_") > 0
          strBuffer = StringField(strBuffer, 2, "_")
          If Val("$" + strBuffer) = $10CF
            bresu = #True
          EndIf
        EndIf
      EndIf
      value + 1
    Wend
  EndIf

  CloseLibrary(idlib)
  CloseLibrary(ielib)
  SetupDiDestroyDeviceInfoList_(hDeviceInfoSet)

  ProcedureReturn bresu

EndProcedure

; ****************************************************************************
; ****************************************************************************
; ****************************************************************************
; ****************************************************************************

; +--------------------------------------------------------------------------+
; |                                                                          |
; +--------------------------------------------------------------------------+

ProcedureDLL AttachProcess(Instance.i)
; INITIALISATION DU MAPPAGE POUR LA LIBRAIRIE.
  hMapFile = CreateFileMapping_($FFFFFFFF, #Null, #PAGE_READWRITE, 0, DataSize, VirtualFileName)
  If hMapFile = 0
    MessageRequester("Error", "Error creating memory mapped file", #PB_MessageRequester_Ok)
  Else
    *ShareData = MapViewOfFile_(hMapFile, #FILE_MAP_WRITE, 0, 0, DataSize)
    If *ShareData = 0
      MessageRequester("Error", "Error creating memory mapped file", #PB_MessageRequester_Ok)
    EndIf
  EndIf

EndProcedure

ProcedureDLL DetachProcess(Instance.i)
; DESINITIALISATION DU MAPPAGE POUR LA LIBRAIRIE.
  UnmapViewOfFile_(*ShareData)
  CloseHandle_(hMapFile)

EndProcedure

ProcedureDLL AttachThread(Instance.i)
;

EndProcedure

ProcedureDLL DetachThread(Instance.i)
;

EndProcedure

; ****************************************************************************
; ****************************************************************************
; ****************************************************************************
; ****************************************************************************

; +--------------------------------------------------------------------------+
; |                                                                          |
; +--------------------------------------------------------------------------+

Procedure.l GetShareData(address.l)
; ROUTINE DE LECTURE DES DONNEES.
  ProcedureReturn PeekL(*ShareData + (address * SizeOf(address)))

EndProcedure

Procedure SetShareData(address.l, ldata.l)
; ROUTINE D'ENVOIS DES DONNEES.
  PokeL(*ShareData + (address * SizeOf(address)), ldata)

EndProcedure

; ****************************************************************************
; ****************************************************************************
; ****************************************************************************
; ****************************************************************************

; +--------------------------------------------------------------------------+
; |                                                                          |
; +--------------------------------------------------------------------------+

ProcedureDLL.b StartDevice()
; DEMARAGE DU CONTRÔLEUR VM116 DE VELLEMAN.
  Define h.l

  If GetFoundVM116_8062() = #True
    SetShareData(1, 222)
    RunProgram("k8062e.exe", "", "", #PB_Program_Hide)
    If GetShareData(1) = 222
      ProcedureReturn #VELLEMAN_INITOK
    EndIf
  EndIf
  ProcedureReturn #VELLEMAN_NOTFOUND

EndProcedure

ProcedureDLL.b StopDevice()
; ARRET DU CONTRÔLEUR VM116 DE VELLEMAN.
  SetShareData(0, 333)

EndProcedure

; ****************************************************************************
; ****************************************************************************
; ****************************************************************************
; ****************************************************************************

; +--------------------------------------------------------------------------+
; |                                                                          |
; +--------------------------------------------------------------------------+

ProcedureDLL.b SetChannelCount(count.l)
; ROUTINE DU NOMBRE DE CHANNEL UTILISE.
  If count > 512
    count = 512
  EndIf
  If count > 0
    SetShareData(2, count)
  EndIf

EndProcedure

; ****************************************************************************
; ****************************************************************************
; ****************************************************************************
; ****************************************************************************

; +--------------------------------------------------------------------------+
; |                                                                          |
; +--------------------------------------------------------------------------+

ProcedureDLL.b SetData(channel.l, ldata.l)
; ROUTINE D'ENVOIS DES DONNEES VM116.
  If channel > 0 And channel < 513
    SetShareData(channel + 10, ldata)
  EndIf
  
EndProcedure
En fait si je le met que maintenant c'est que j'ai decouvert mon erreur que maintenant, pares beaucoup de tests.

Cordialement,
GallyHC
Fuseau horaire sur UTC+01:00
Page 2 sur 2

Développé par phpBB® Forum Software © phpBB Limited

Traduction française officielle © Qiaeru