PureBasic

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

suivi de registre

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

Page 1 sur 1

suivi de registre

Publié : mer. 29/déc./2004 19:51
par hardy
Nouvelle version du prog de suivi de registre.
J'ai gagné quelques secondes pour les clichés en codant un bout en ASM.
Ca suffira, je pense : 3-4 secondes pour un cliché.
J'optimiserai aussi la comparaison (actuellement, entre 2 et 8 secondes).
Puis faudra ajouter des fonctions de restauration de clés,...
Pour le faire tourner, modifier icône et image (ou supprimer simplement)

Code : Tout sélectionner

Global path.s,nbimage,comparaison.b,aa,bb,*memoire1,*memoire2,titre.s
path=Space(255) 
GetModuleFileName_(0,@path,255)

While Right(path,1)<>"\"
path=Left(path,Len(path)-1)
Wend

CreateDirectory(path+"clichés")

;path="c:\surveillance\"

;-A MODIFIER--------------- ainsi que le la fin (label Berlioz)

LoadImage(0,path+"berlioz.ico")

Global amem,amem2,count2,lim,zero.b


;----------------déclarations ---------------------
Structure m
  adresse1.l
  adresse2.l

  type.b
EndStructure
Dim modif.m(5000)
Global nmodif
Dim charge.b(5000)

Declare cliche()
Declare suppression()
Declare sauver()
Declare refresh()
Declare modifications()
Declare details(i)


  
;--------------- Lecture config---------------------
Dim image.s(200)
Dim temps.s(200)
nbimage=0
If ReadFile(0,path+"breg.cfg")
  Repeat
    nbimage+1
    image(nbimage)=ReadString()
    temps(nbimage)=ReadString()
    If image(nbimage)="":nbimage-1:EndIf
  Until Eof(0) Or nbimage=199
  CloseFile(0)
EndIf


;--------------Main------------------------
start=1 : run=1 

Global win
h=OpenProcess_($1F0FFF,0,GetCurrentProcessId_())
SetPriorityClass_(h,#HIGH_PRIORITY_CLASS)
CloseHandle_(h)

titre.s="Suivi du registre"
win.l=OpenWindow(0,0,0,530,380,#PB_Window_SystemMenu|#PB_Window_MinimizeGadget|#PB_Window_ScreenCentered,titre)
If win=0:End:EndIf
couleur=GetSysColor_(#COLOR_3DFACE)

CreateGadgetList(win)
CreateImage(2,167,60)
StartDrawing(ImageOutput())
Box(0,0,167,60,couleur)
Locate(0,0)
FrontColor($D6,$B5,$29)
DrawingMode(1)
LoadFont(0,"Times New Roman",12,#PB_Font_Italic|#PB_Font_HighQuality)
DrawingFont(FontID())
DrawText("Suivi registre v 1.0")
Locate(0,18)
DrawText("Pascal Tonnelier")
Locate(0,36)
DrawText("12/2004")
CloseFont(0)
StopDrawing()
ImageGadget(99,355,290,167,60,UseImage(2))
Image= CatchImage(1, ?Berlioz)
StartDrawing(ImageOutput())
DrawingMode(4)
FrontColor($D6,$B5,$29)
Box(0,0,167,251)
Box(1,1,165,249)
Box(2,2,163,247)
StopDrawing()
ImageGadget(100, 355,30,167,250,Image)

ListIconGadget(1,0,10,343,330,"Clichés registre",400,#PB_ListIcon_FullRowSelect|#PB_ListIcon_CheckBoxes|#PB_ListIcon_AlwaysShowSelection)
ButtonGadget(2,10,350,100,20,"Prendre un cliché")
ButtonGadget(3,120,350,120,20,"Comparer deux clichés")
ButtonGadget(4,260,350,60,20,"Effacer")

refresh()

run=1
SetWindowText_(win,@titre)
HideWindow(0,1)
AddSysTrayIcon(0,win,UseImage(0))
SysTrayIconToolTip(0,titre)
HideWindow(0,0)
debut:
Repeat
event=WaitWindowEvent()

If IsIconic_(win)<>0 And hide=0
HideWindow(0,1):hide=1
EndIf
Select event
  
Case #PB_Event_SysTray
  HideWindow(0,0):hide=0
  SetForegroundWindow_(win)
Case #PB_Event_CloseWindow
  Select EventWindowID()
    Case 0
    run=0
    Case 10
    CloseWindow(10)
    FreeMemory(*memoire1)
    FreeMemory(*memoire2)
    DisableGadget(3,0)
    
  Default
    CloseWindow(EventWindowID())
  EndSelect
    
  Case #PB_Event_Gadget
    Select EventGadgetID()
      Case 11
        For i=1 To nmodif
          If GetGadgetItemState(11,i-1)&#PB_ListIcon_Selected
            details(i)
            Break
          EndIf
        Next i
      Case 2
        For i=2 To 4:DisableGadget(i,1):Next i
        cliche()
        For i=2 To 4:DisableGadget(i,0):Next i
      Case 4
        suppression()
        
      Case 3
        
        n=0
        For i=1 To nbimage
          If GetGadgetItemState(1,i-1)=#PB_ListIcon_Checked Or GetGadgetItemState(1,i-1)=#PB_ListIcon_Checked|#PB_ListIcon_Selected
            n+1
            If n=1 : aa=i :Else: bb=i:EndIf
          EndIf
        Next i
        If n<>2
          MessageRequester("Comparaison de clichés","Sélectionner exactement deux clichés")
          Goto debut
        EndIf
        DisableGadget(3,1)
        
        nmodif=0

        If OpenWindow(10,0,0,1000,415,#PB_Window_ScreenCentered|#PB_Window_SystemMenu,"Modifications entre le cliché "+Chr(34)+image(aa)+Chr(34)+" et le cliché "+Chr(34)+image(bb)+Chr(34))
          CreateGadgetList(WindowID(10))
          ListIconGadget(11,5,5,500,400,"modifications",1500)
          ListIconGadget(12,510,5,490,400,"détails (sélectionner une modification)",1500)
          modifications()
          EndIf
  EndSelect
  
EndSelect
Until run=0
End

Procedure cliche()
debutcliche:
nom.s=InputRequester("Cliché de registre","Choisissez un nom (uniquement des lettres et des chiffres)","")
  If nom=""
    MessageRequester("Cliché registre","Nom vide = cliché annulé")
    ProcedureReturn
  EndIf
  For i=1 To nbimage
    If nom=image(i)
      MessageRequester("cliché de registre","Nom déjà utilisé")
      Goto debutcliche
    EndIf
  Next i
  
  SetWindowTitle(0,titre+"     Cliché en cours...")
  UpdateWindow_(WindowID(0))
  time.s=Space(255)
  date.s=Space(255)
  gettimeformat_(0,8,0,0,@time,255)
  getdateformat_(0,1,0,0,@date,255)
  date=date+"  "+time
  DeleteFile("c:\bregistre.reg")
  Delay(100)
  RunProgram("regedit.exe","/e c:\bregistre.reg","",1)
  Delay(50)
  If ReadFile(0,"c:\bregistre.reg")
    l=Lof()
    *mem=AllocateMemory(l)
    *memo=*mem
    If *mem
      ReadData(*mem,l)
      CloseFile(0)
      DeleteFile("c:\bregistre.reg")
    Else
      CloseFile(0)
      ProcedureReturn
    EndIf
    
    *mem2=AllocateMemory(l)
    *memo2=*mem2
    If *mem And *mem2
      
;      Goto regulier
      
;-nouveau code asm
      lim=*memo+l-1
      amem=*mem
      amem2=*mem2
       
      !XOR ecx,ecx
      !MOV eax,[v_amem]
      !MOV ebx,[v_amem2]
      
      !boucle:
      !MOV dl,byte[eax]
      !CMP dl,0
      !JLE cas2
      !CMP dl,13
      !JE cas3
      !CMP dl,10
      !JE cas3
      
      !INC ecx
      !MOV byte[ebx],dl
      !INC eax
      !INC ebx
      !JMP fin
      
      !cas3:
      !MOV byte[ebx],0
      !INC ebx
      !INC ecx
      !repete:
      !INC eax
      !MOV dl,byte[eax]
      !CMP eax,[v_lim]
      !JE fin
      !CMP dl,13
      !JE repete
      !CMP dl,10
      !JE repete
      !CMP dl,0
      !JLE repete
      !JMP fin
      
      !cas2:
      !INC eax
      
      !fin:
      
      !CMP eax,[v_lim]
      !JLE boucle
      !MOV [v_amem2],ebx
      !MOV [v_count2],ecx
      
      *mem=amem
      *mem2=amem2
      count=count2
      
      Goto suite

      regulier:
 ;-ancien code     
      While *mem<*memo+l
        a.b=PeekB(*mem)
        
        If a>0
          If a<>13 And a<>10
            count+1  
            PokeB(*mem2,a)
            *mem2+1
            *mem+1
          Else
            PokeB(*mem2,0)
            *mem2+1
            count+1
            Repeat
              *mem+1
            Until  (PeekB(*mem)<>13 And PeekB(*mem)<>10 And PeekB(*mem)>0) Or *mem=*memo+l-1
          EndIf
        Else
          *mem+1
        EndIf
        
      Wend
 
      suite:
      
      PokeS(*mem2,"[berliozo]")
      If OpenFile(1,path+"clichés/"+nom+".breg")
        *mem2-count
        UseFile(1)
        WriteData(*mem2,count+11)
        CloseFile(1)
        sauver()
        MessageRequester("Cliché de registre","Cliché effectué")
        nbimage+1
        image(nbimage)=nom
        temps(nbimage)=date
      EndIf
  EndIf
  EndIf 
  FreeMemory(*memo)
  FreeMemory(*memo2)
  sauver()
  refresh()
  SetWindowTitle(0,titre)
EndProcedure

Procedure suppression()
  nbimage2=0
  Dim image2.s(200)
  For i=1 To nbimage
    If GetGadgetItemState(1,i-1)=#PB_ListIcon_Checked Or GetGadgetItemState(1,i-1)=#PB_ListIcon_Checked|#PB_ListIcon_Selected
      DeleteFile(path+"clichés/"+image(i)+".breg")
    Else
      nbimage2+1
      image2(nbimage2)=image(i)
    EndIf
  Next i
  nbimage=nbimage2
  For i=1 To nbimage
    image(i)=image2(i)
  Next i
  refresh()
  sauver()
EndProcedure

Procedure sauver()
  DeleteFile(path+"breg.cfg")
  If OpenFile(0,path+"breg.cfg")
    For i=1 To nbimage
;      Debug image(i)
;      Debug temps(i)
      WriteStringN(image(i))
      WriteStringN(temps(i))
    Next i
    CloseFile(0)
  EndIf
EndProcedure

Procedure refresh()
  ClearGadgetItemList(1)
  For i=1 To nbimage
    AddGadgetItem(1,-1,image(i)+" : le "+temps(i))
  Next i
EndProcedure

Procedure modifications()

  If OpenFile(0,path+"clichés\"+image(aa)+".breg") And OpenFile(1,path+"clichés\"+image(bb)+".breg")
    UseFile(0)
    l=Lof()
    
    *mem=AllocateMemory(l)
    *memoire1=*mem
    
    If *mem=0
      CloseFile(0)
      CloseFile(1)
      Goto debut
    EndIf
    
    ReadData(*mem,l)
    CloseFile(0)
    
    UseFile(1)
    l2=Lof()
    *mem2=AllocateMemory(l2)
    *memoire2=*mem2
    If *mem2=0 
      CloseFile(1)
      FreeMemory(*mem)
      Goto debut
    EndIf
    ReadData(*mem2,l2)
    
    CloseFile(1)
     
    While PeekS(*mem)<>"[berliozo]" And PeekS(*mem2)<>"[berliozo]"
      
      Select CompareMemoryString(*mem,*mem2,1)
        Case -1
          a.s=PeekS(*mem)
          AddGadgetItem(11,-1,"clé effacée = "+a)
          nmodif+1
          modif(nmodif)\adresse1=*mem
          modif(nmodif)\type=1
   ;       details(nmodif)
          Repeat
            *mem+Len(a)+1
            a.s=PeekS(*mem)
          Until Left(a,1)="["
        Case 1
          a.s=PeekS(*mem2)
          AddGadgetItem(11,-1,"clé créée = "+a)
          nmodif+1
          modif(nmodif)\adresse2=*mem2
          modif(nmodif)\type=2
  ;        details(nmodif)
          Repeat
            *mem2+Len(a)+1
            a.s=PeekS(*mem2)
          Until Left(a,1)="["
        Case 0
          debut1=*mem
          debut2=*mem2
          a.s=PeekS(*mem)
          Repeat
            *mem+Len(a)+1
            a.s=PeekS(*mem)
          Until Left(a,1)="["
          a.s=PeekS(*mem2)
          Repeat
            *mem2+Len(a)+1
            a.s=PeekS(*mem2)
          Until Left(a,1)="["
          l1=*mem-debut1:l2=*mem2-debut2
          If l1<>l2
            AddGadgetItem(11,-1,"clé modifiéé = "+PeekS(debut1))
            nmodif+1
            modif(nmodif)\adresse1=debut1
            modif(nmodif)\adresse2=debut2
            modif(nmodif)\type=3
  
          Else
            If CompareMemory(debut1,debut2,l1)=0
              AddGadgetItem(11,-1,"clé modifiée = "+PeekS(debut1))
              nmodif+1
              modif(nmodif)\adresse1=debut1
              modif(nmodif)\adresse2=debut2
              modif(nmodif)\type=3
            EndIf
          EndIf
          
      EndSelect
    Wend
          
        EndIf 

     EndProcedure
  
Procedure details(i)
      ClearGadgetItemList(12)
 Select modif(i)\type
    Case 1
      *mem=modif(i)\adresse1
      a.s=PeekS(*mem)
      AddGadgetItem(12,-1,"anciennes valeurs de "+a)
      AddGadgetItem(12,-1,"******************************************************************************************************************")
      *mem+Len(PeekS(*mem))+1
      a=PeekS(*mem)
      While Left(a,1)<>"[" 
;        count2+1
        AddGadgetItem(12,-1,ReplaceString(a,"@=","(par défaut)="))
        *mem+Len(a)+1
        a=PeekS(*mem)
      Wend
      
    Case 2
      *mem2=modif(i)\adresse2
      a.s=PeekS(*mem2)
      AddGadgetItem(12,-1,"nouvelles valeurs de "+a)
      AddGadgetItem(12,-1,"******************************************************************************************************************")
      *mem2+Len(PeekS(*mem2))+1
      a=PeekS(*mem2)
      While Left(a,1)<>"["
 ;       count2+1
        AddGadgetItem(12,-1,ReplaceString(a,"@=","(par défaut)="))
        *mem2+Len(a)+1
        a=PeekS(*mem2)
      Wend
    Case 3
      *mem=modif(i)\adresse1
      a.s=PeekS(*mem)
      AddGadgetItem(12,-1,"anciennes valeurs de "+a)
      AddGadgetItem(12,-1,"******************************************************************************************************************")
      *mem+Len(PeekS(*mem))+1
      a=PeekS(*mem)
      While Left(a,1)<>"["
;        count2+1
        AddGadgetItem(12,-1,ReplaceString(a,"@=","(par défaut)="))
        *mem+Len(a)+1
        a=PeekS(*mem)
      Wend
      *mem2=modif(i)\adresse2
      a.s=PeekS(*mem2)
      AddGadgetItem(12,-1,"******************************************************************************************************************")
      AddGadgetItem(12,-1,"nouvelles valeurs de "+a)
      AddGadgetItem(12,-1,"******************************************************************************************************************")
      *mem2+Len(PeekS(*mem2))+1
      a=PeekS(*mem2)
      While Left(a,1)<>"[" 
        count2+1
        AddGadgetItem(12,-1,ReplaceString(a,"@=","(par défaut)="))
        *mem2+Len(a)+1
        a=PeekS(*mem2)
      Wend
      AddGadgetItem(12,-1,"******************************************************************************************************************")
      
  EndSelect
EndProcedure




Berlioz:IncludeBinary "d:\imageberliozo.bmp"
Fuseau horaire sur UTC+01:00
Page 1 sur 1

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

Traduction française officielle © Qiaeru