Cacher un fichier zip dans une image gif

[falsam]

Le principe consiste à sélectionner une image gif puis un fichier zip et enfin donner un nom au nouveau fichier gif qui contiendra votre zip.

Vous pouvez ouvrir l'image nouvellement crée avec Winrar ou 7Zip par exemple.

Ce code fonctionne sous Window 7 et je ne l'ai pas testé avec Window XP.
Il ne demande qu'à être améliorer.

Code : Tout sélectionner

;ZipToImage V1.01 - By falsam 
;
;PB 4.51+ - Window 7
EnableExplicit

Enumeration
  #FontApp
  #Mainform
  
  #File_Image
  #File_Zip
  #File_Final
  
  #Select_Image
  #Select_Zip
  #Select_Final
  
  #Run
EndEnumeration


Define.l Event, WEvent, MEvent, GEvent, TEvent

Global WindowStyle.i=#PB_Window_MinimizeGadget|#PB_Window_ScreenCentered

Global File_Image.s, File_Zip.s, File_Final.s, File.s, Pattern.s, Cmd.s

Procedure Open_MainForm()
  OpenWindow(#Mainform, 0, 0, 500, 250, "Cacher des données dans une image", WindowStyle)
  
  TextGadget(#File_Image, 20, 30, 400, 24, "Your image file", #PB_Text_Border)
  SetGadgetColor(#File_Image, #PB_Gadget_BackColor, #White) 
  SetGadgetColor(#File_Image, #PB_Gadget_FrontColor, RGB(140, 140, 140)) 
  ButtonGadget(#Select_Image, 430, 30, 24, 24, "?")
  
  TextGadget(#File_zip, 20, 70, 400, 24, "Your zip file", #PB_Text_Border)
  SetGadgetColor(#File_Zip, #PB_Gadget_BackColor, #White) 
  SetGadgetColor(#File_Zip, #PB_Gadget_FrontColor, RGB(140, 140, 140))
  ButtonGadget(#Select_Zip, 430, 70, 24, 24, "?")
  
  StringGadget(#File_Final, 20, 110, 400, 24, "Your final image.gif")
  SetGadgetColor(#File_final, #PB_Gadget_BackColor, #White) 
  ButtonGadget(#Select_final, 430, 110, 24, 24, "?")
  
  ButtonGadget(#Run, 200, 150, 100, 24, "Execute")
  
EndProcedure

Procedure Start()
  ;Font Application
  LoadFont(#FontApp, "Arial", 10)
  SetGadgetFont(#PB_Default,FontID(#FontApp)) 

  Open_MainForm()
EndProcedure

start()

Repeat
  Event  = WaitWindowEvent(10)
  WEvent = EventWindow()
  MEvent = EventMenu()
  GEvent = EventGadget()
  TEvent = EventType()
  Select Event
    Case #PB_Event_Gadget
      Select GEvent
        Case #Select_Image, #Select_Zip, #Select_Final
          If GEvent = #Select_Image Or GEvent = #Select_Final
            Pattern = "*.GIF|*.GIF"
          Else
            Pattern = "*.ZIP|*.ZIP"
          EndIf
          
          File = OpenFileRequester("Choississez un fichier", "", Pattern, 0)
          
          If File 
            Select GEvent
              Case #Select_Image
                SetGadgetText(#File_Image, File)
                
              Case #Select_Zip
                SetGadgetText(#File_zip, File)
                
              Case #Select_Final
                If Not FindString(File, ".gif")
                  File + ".gif"
                EndIf
                SetGadgetText(#File_Final, File)
                
            EndSelect
          EndIf
                   
        Case #Run
          
          File_Image = GetGadgetText(#File_Image)
          File_Zip = GetGadgetText(#File_Zip)
          File_Final = GetGadgetText(#File_Final)
          If Not FindString(File_Final, ".gif")
            File_Final + ".gif"
          EndIf
                             
          If ReadFile(#PB_Any, File_Image) And ReadFile(#PB_Any, File_zip)
            
            Cmd = " /c copy /B "
            Cmd + Chr(34)+File_Image+Chr(34)
            Cmd + "+"
            Cmd + Chr(34)+File_Zip+ Chr(34)
            Cmd + " "
            Cmd + Chr(34)+File_Final+Chr(34)
            
            RunProgram("cmd.Exe", Cmd, "", #PB_Program_Wait|#PB_Program_Hide) 
            
            If ReadFile(#PB_Any, File_Final)
              MessageRequester("Information", "Création du fichier terminé.")
            Else
              MessageRequester("Information", "Une erreur c'est produite lors de la constritution du fichier.")
            EndIf
            
          Else
            MessageRequester("Information", "Un des fichiers (ou les deux) est invalide")
          EndIf
          
      EndSelect
        
    Case #PB_Event_CloseWindow
      End
  EndSelect
ForEver

J'ai corrigé une erreur de dernière minute.

[Mesa]

Malheureusement sous XP, le flag #PB_Program_Hide empêche que ça fonctionne.

Sur purearea.net, on trouve deux codes qui fonctionnent, voir ci-dessous

Code : Tout sélectionner

;ZipToImage V1.01 - By falsam 
;
;PB 5.00 - Window xp
;EnableExplicit

Enumeration
  #FontApp
  #Mainform
  
  #File_Image
  #File_Zip
  #File_Final
  
  #Select_Image
  #Select_Zip
  #Select_Final
  
  #Run
EndEnumeration


Define.l Event, WEvent, MEvent, GEvent, TEvent

Global WindowStyle.i=#PB_Window_MinimizeGadget|#PB_Window_ScreenCentered

Global File_Image.s, File_Zip.s, File_Final.s, File.s, Pattern.s, Cmd.s


Procedure.l RunProgramEx2(Filename.s, Parameter.s, Directory.s, ShowFlag.l) 
  ; German forum: http://www.purebasic.fr/german/archive/viewtopic.php?t=3708&highlight=
; Author: Timo Gärtner
; Date: 15. February 2004
; OS: Windows
; Demo: No

; Funktioniert bei *.exe/*.com/*.bat - Dateien. 
  Info.STARTUPINFO 
  Info\cb          =SizeOf(STARTUPINFO)    
  Info\dwFlags     =1                    ;#STARTF_USESHOWWINDOW 
  Info\wShowWindow =ShowFlag 
  ProcessInfo.PROCESS_INFORMATION    
  ProcessPriority=$20                    ;NORMAL_PRIORITY 
  ;Create a window and retrieve its process 
  If CreateProcess_(@Filename, @Parameter, 0, 0, 0, ProcessPriority, 0, @Directory, @Info, @ProcessInfo) 
    ;Process Values      
    ProcessID.l =ProcessInfo\dwProcessId 
    ;Find Window Handle of Process 
    Repeat 
      win=FindWindow_(0,0) 
      While win<>0 And quit=0 
        GetWindowThreadProcessId_(win, @pid.l) 
        If pid=ProcessID 
          WinHandle=win 
          quit=1 
        EndIf 
        win=GetWindow_(win, #GW_HWNDNEXT)          
      Wend 
    Until WinHandle 
  EndIf 
  ;Retrieve Window Handle 
  ProcedureReturn WinHandle 
EndProcedure  


Procedure.l RunProgramEx(Filename.s, Parameter.s, Directory.s, ShowFlag.l) 
  ; English forum: http://www.purebasic.fr/english/viewtopic.php?t=6753&highlight=
  ; Author: Eddy
  ; Date: 29. June 2003
  ; OS: Windows
  ; Demo: No
  
  
  ; RunProgramEx : retrieve handle of opened window 
  
  ; /////////////////////// 
  ; Run Program Ex 
  ; /////////////////////// 
  Info.STARTUPINFO 
  Info\cb          =SizeOf(STARTUPINFO)    
  Info\dwFlags     =1                    ;#STARTF_USESHOWWINDOW 
  Info\wShowWindow =ShowFlag 
  
  ProcessInfo.PROCESS_INFORMATION    
  ProcessPriority=$20                    ;NORMAL_PRIORITY 
  
  ;Create a window and retrieve its process 
  If CreateProcess_(@Filename, @Parameter, 0, 0, 0, ProcessPriority, 0, @Directory, @Info, @ProcessInfo) 
    
    ;Process Values      
    ProcessID.l =ProcessInfo\dwProcessId 
    
    ;Find Window Handle of Process 
    Repeat 
      win=FindWindow_(0,0) 
      While win<>0 And quit=0 
        GetWindowThreadProcessId_(win, @pid.l) 
        If pid=ProcessID 
          WinHandle=win 
          quit=1 
        EndIf 
        win=GetWindow_(win, #GW_HWNDNEXT)          
      Wend 
    Until WinHandle 
  EndIf 
  
  ;Retrieve Window Handle 
  ProcedureReturn WinHandle 
EndProcedure 




Procedure.s GetSystemDir() 
  ; ///////////////////////////// 
; System Directory 
; ///////////////////////////// 
  systemdir$=Space(255) 
  lg = GetSystemDirectory_(systemdir$, 255) 
  systemdir$=Left(systemdir$,lg) 
  ProcedureReturn systemdir$ 
EndProcedure 

Procedure Open_MainForm()
  OpenWindow(#Mainform, 0, 0, 500, 250, "Cacher des données dans une image", WindowStyle)
  
  TextGadget(#File_Image, 20, 30, 400, 24, "Your image file", #PB_Text_Border)
  SetGadgetColor(#File_Image, #PB_Gadget_BackColor, #White) 
  SetGadgetColor(#File_Image, #PB_Gadget_FrontColor, RGB(140, 140, 140)) 
  ButtonGadget(#Select_Image, 430, 30, 24, 24, "?")
  
  TextGadget(#File_zip, 20, 70, 400, 24, "Your zip file", #PB_Text_Border)
  SetGadgetColor(#File_Zip, #PB_Gadget_BackColor, #White) 
  SetGadgetColor(#File_Zip, #PB_Gadget_FrontColor, RGB(140, 140, 140))
  ButtonGadget(#Select_Zip, 430, 70, 24, 24, "?")
  
  StringGadget(#File_Final, 20, 110, 400, 24, "Your final image.gif")
  SetGadgetColor(#File_final, #PB_Gadget_BackColor, #White) 
  ButtonGadget(#Select_final, 430, 110, 24, 24, "?")
  
  ButtonGadget(#Run, 200, 150, 100, 24, "Execute")
  
EndProcedure

Procedure Start()
  ;Font Application
  LoadFont(#FontApp, "Arial", 10)
  SetGadgetFont(#PB_Default,FontID(#FontApp)) 
  
  Open_MainForm()
EndProcedure

start()

Repeat
  Event  = WaitWindowEvent(10)
  WEvent = EventWindow()
  MEvent = EventMenu()
  GEvent = EventGadget()
  TEvent = EventType()
  Select Event
    Case #PB_Event_Gadget
      Select GEvent
        Case #Select_Image, #Select_Zip, #Select_Final
          If GEvent = #Select_Image Or GEvent = #Select_Final
            Pattern = "*.GIF|*.GIF"
          Else
            Pattern = "*.ZIP|*.ZIP"
          EndIf
          
          File = OpenFileRequester("Choississez un fichier", "", Pattern, 0)
          
          If File 
            Select GEvent
              Case #Select_Image
                SetGadgetText(#File_Image, File)
                
              Case #Select_Zip
                SetGadgetText(#File_zip, File)
                
              Case #Select_Final
                If Not FindString(File, ".gif")
                  File + ".gif"
                EndIf
                SetGadgetText(#File_Final, File)
                
            EndSelect
          EndIf
          
        Case #Run
          
          File_Image = GetGadgetText(#File_Image)
          File_Zip = GetGadgetText(#File_Zip)
          File_Final = GetGadgetText(#File_Final)
          If Not FindString(File_Final, ".gif")
            File_Final + ".gif"
          EndIf
          
          If ReadFile(#PB_Any, File_Image) And ReadFile(#PB_Any, File_zip)
            
            Cmd = " /c copy /B " 
            Cmd + Chr(34)+File_Image+Chr(34) 
            Cmd + "+" 
            Cmd + Chr(34)+File_Zip+ Chr(34) 
            Cmd + " " 
            Cmd + Chr(34)+File_Final+Chr(34); + #CRLF$
            
            app=RunProgram("cmd.exe", Cmd, "", #PB_Program_Open) ; Le #PB_Program_Hide ne fonctionne pas
            ;app=RunProgramEx(GetSystemDir()+"\cmd.exe",cmd,GetSystemDir()+"\",#SW_HIDE) ; fonctionne
            ;app=RunProgramEx2(GetSystemDir()+"\cmd.exe",cmd,GetSystemDir()+"\",#SW_HIDE) ; fonctionne
            
            ok=#False
            For i=1 To 5
              If ReadFile(#PB_Any, File_Final)
                MessageRequester("Information", "Création du fichier terminé.")
                RunProgram(File_Final)
                ok=#True
                Break
              Else
                Delay(1000)
              EndIf
            Next i
            
            If ok=#False
              MessageRequester("Information", "Une erreur c'est produite lors de la constritution du fichier.")
            EndIf
            
          Else
            MessageRequester("Information", "Un des fichiers (ou les deux) est invalide")
          EndIf
          
          CloseProgram(app) 
      EndSelect
      
    Case #PB_Event_CloseWindow
      End
  EndSelect
ForEver

Mesa.