Vous tester ICI http://www.purebasic.fr/french/viewtopi ... 02#p176502
Logiciel pour votre placer vos sources sur votre serveur
Code : Tout sélectionner
;**********************************************************************************************************
; Author : MicrodevWeb
; Name : PbPacker
;{ Historique of version
;{ ------ Version : B0.01 Create: 2015/10/30 Finshed :
; -------- Fist beta version
;}
;}
; Use PB 5.40
;**********************************************************************************************************
;-* Enumeration Constante
#Title="Pb Pacher B0.01"
Enumeration Langage
#Fr
#En
EndEnumeration
Enumeration Form
#MainForm
#MainMenu
#LstFile
#M_AddFile
#M_RemoveFile
#M_EditFile
#M_New
#M_Open
#M_Save
#M_SaveAs
#M_Exit
#M_FtpParameter
#M_FtpSend
#LangageForm
#BtFr
#BtEn
#AddFileForm
#AddFileExploreur
#AddFileFileName
#AddFileVersion
#AddFileSubmit
#AddFileChancel
#FtpForm
#FtpName
#FtpUser
#FtpPsw
#FtpDirectory
#FtpPassifMode
#FtpPort
#FtpSubmit
#FtpChancel
#FtpVersion
#FtpPacker
EndEnumeration
Enumeration Font
#ArialM
EndEnumeration
;}
;-* Global Variables
Global gCurrentLangage,gPrefFileName$="parameters.pref"
Global Dim gTxt$(2,50),gModeNew.b,BkpFile$,gModeSend.b=#False
;}
;-* Catch
LoadFont(#ArialM,"Arial",12,#PB_Font_HighQuality)
;}
;-* Structure / List / Map
Structure file
name$
version$
EndStructure
Structure project
FtpServer$
FtpUser$
FtpPsw$
FtpPasif.b
FtpPort.i
FtpDirectory$
PackerFileName$
VersionFileName$
List myFile.file()
EndStructure
Global myProject.project
;}
;-* Langage Management
gTxt$(#Fr,0)="Parlez-vous Français?"
gTxt$(#En,0)="Do you speak English?"
gTxt$(#Fr,1)="Fichier"
gTxt$(#En,1)="File"
gTxt$(#Fr,2)="Ouvrir"+Chr(9)+"CTRL O"
gTxt$(#En,2)="Open"+Chr(9)+"CTRL O"
gTxt$(#Fr,3)="Sauver"+Chr(9)+"CTRL S"
gTxt$(#En,3)="Save"+Chr(9)+"CTRL S"
gTxt$(#Fr,4)="Sauver sous"
gTxt$(#En,4)="Save as"
gTxt$(#Fr,5)="Nouveau"+Chr(9)+"CTRL N"
gTxt$(#En,5)="New"+Chr(9)+"CTRL N"
gTxt$(#Fr,6)="Quitter"
gTxt$(#En,6)="Exit"
gTxt$(#Fr,7)="Contenu"
gTxt$(#En,7)="Contents"
gTxt$(#Fr,8)="Ajouter"+Chr(9)+"ALT A"
gTxt$(#En,8)="Add"+Chr(9)+"ALT A"
gTxt$(#Fr,9)="Retirer"+Chr(9)+"Delete"
gTxt$(#En,9)="Remove"+Chr(9)+"Delete"
gTxt$(#Fr,10)="Ajout de contenu"
gTxt$(#En,10)="Add content"
gTxt$(#Fr,11)="Fichier à inclure"
gTxt$(#En,11)="File to inclued"
gTxt$(#Fr,12)="Version du fichier"
gTxt$(#En,12)="File version"
gTxt$(#Fr,13)="Valider"
gTxt$(#En,13)="Submit"
gTxt$(#Fr,14)="Annuler"
gTxt$(#En,14)="Chancel"
gTxt$(#Fr,15)="Vous n'avez pas renseigné de nom de fichier"
gTxt$(#En,15)="You have not filled in file name"
gTxt$(#Fr,16)="Vous n'avez pas renseigné de version de fichier"
gTxt$(#En,16)="You have not filled in file version"
gTxt$(#Fr,17)="Le fichier n'existe pas"
gTxt$(#En,17)="The file does not exist"
gTxt$(#Fr,18)="Sélection d'un fichier"
gTxt$(#En,18)="Selecting a file"
gTxt$(#Fr,19)="Editer"+Chr(9)+"ALT E"
gTxt$(#En,19)="Edit"+Chr(9)+"ALT E"
gTxt$(#Fr,20)="Edition de contenu"
gTxt$(#En,20)="Edit the content"
gTxt$(#Fr,21)="Sauvegarde de votre projet"
gTxt$(#En,21)="Saving your project"
gTxt$(#Fr,22)="Ouverture d'un projet"
gTxt$(#En,22)="Opening a project"
gTxt$(#Fr,23)="Paramètre Ftp"
gTxt$(#En,23)="Ftp parameters"
gTxt$(#Fr,24)="Serveur de la connection"
gTxt$(#En,24)="Connection server"
gTxt$(#Fr,25)="Nom d'utilisateur"
gTxt$(#En,25)="User name"
gTxt$(#Fr,26)="Mot de passe"
gTxt$(#En,26)="Password"
gTxt$(#Fr,27)="Numéro de port"
gTxt$(#En,27)="Port number"
gTxt$(#Fr,28)="Mode passif"
gTxt$(#En,28)="Passif mode"
gTxt$(#Fr,29)="Envoi"
gTxt$(#En,29)="Send"
gTxt$(#Fr,30)="Répertoire"
gTxt$(#En,30)="Directory"
gTxt$(#Fr,31)="Vous n'avez pas renseigné de nom du serveur"
gTxt$(#En,31)="You have not filled in server name"
gTxt$(#Fr,32)="Vous n'avez pas renseigné de nom d'utilisateur"
gTxt$(#En,32)="You have not filled in user name"
gTxt$(#Fr,34)="Vous n'avez pas renseigné de mot de passe"
gTxt$(#En,34)="You have not filled in password"
gTxt$(#Fr,35)="Le numero de port ne doit pas être 0"
gTxt$(#En,35)="The port number must not be 0"
gTxt$(#Fr,36)="Nom du fichier de version"
gTxt$(#En,36)="Version file name"
gTxt$(#Fr,37)="Nom du fichier Zip"
gTxt$(#En,37)="Zip file name"
gTxt$(#Fr,38)="Vous n'avez pas renseigné de nom de fichier de version"
gTxt$(#En,38)="You have not filled in version file name"
gTxt$(#Fr,39)="Vous n'avez pas renseigné de nom de fichier Zip"
gTxt$(#En,39)="You have not filled in Zip file name"
gTxt$(#Fr,40)="Vous n'avez pas renseigné de nom dr répertoire"
gTxt$(#En,40)="You have not filled in directory name"
gTxt$(#Fr,41)="Envoie Ftp"
gTxt$(#En,41)="Ftp send"
gTxt$(#Fr,42)="Envoyer avec succès"
gTxt$(#En,42)="Send successfully"
gTxt$(#Fr,43)=" Retirer une inclusion"
gTxt$(#En,43)=" Remove include"
gTxt$(#Fr,44)=" Etes-vous sure?"
gTxt$(#En,44)=" Are uou sure?"
;}
;-* Declare
Declare OpenMainForm()
Declare OpenAddFile()
Declare EventSave()
Declare OpenFtpParameters()
Declare EventFtpParameters()
Declare EventFtpSend()
;}
;-* Other Function
Procedure FillsListeFile()
Protected Values$,Sel,N,*CurrentFile
*CurrentFile=@myProject\myFile()
ClearGadgetItems(#LstFile)
ForEach myProject\myFile()
With myProject\myFile()
Values$=\name$+Chr(10)+\version$
AddGadgetItem(#LstFile,-1,Values$)
SetGadgetItemData(#LstFile,N,@myProject\myFile())
If *CurrentFile=@myProject\myFile()
Sel=N
EndIf
N+1
EndWith
Next
SetActiveGadget(#LstFile)
SetGadgetState(#LstFile,Sel)
EndProcedure
Procedure OpenProject()
ClearStructure(@myProject,project)
InitializeStructure(@myProject,project)
myJson=LoadJSON(#PB_Any,BkpFile$,#PB_JSON_NoCase)
If myJson=0
MessageRequester("Json Error","Line "+Str(JSONErrorLine())+" : "+JSONErrorPosition())
ProcedureReturn
EndIf
ExtractJSONStructure(JSONValue(myJson),@myProject,project)
OpenPreferences(gPrefFileName$)
WritePreferenceString("Last_project",BkpFile$)
ClosePreferences()
FillsListeFile()
DisableMenuItem(#MainMenu,#M_Save,#True)
EndProcedure
;}
;-* Event Management
Procedure EventSize()
Protected WF=WindowWidth(#MainForm),
HF=WindowHeight(#MainForm),
M=10,WL=(WF-(M*2)),HL=(HF-(M*4)),X=M,Y=M,
CurrentRow=GetGadgetState(#LstFile)
ResizeGadget(#LstFile,X,Y,WL,HL)
RemoveGadgetColumn(#LstFile,0)
AddGadgetColumn(#LstFile,0,gTxt$(gCurrentLangage,7),WL*0.7)
AddGadgetColumn(#LstFile,1,"Version",(WL*0.3)-5)
FillsListeFile()
SetActiveGadget(#LstFile)
SetGadgetState(#LstFile,CurrentRow)
EndProcedure
Procedure EventRemove()
If GetGadgetState(#LstFile)=-1
ProcedureReturn
EndIf
If MessageRequester(gTxt$(gCurrentLangage,43),gTxt$(gCurrentLangage,44),#PB_MessageRequester_YesNo)=#PB_MessageRequester_No
ProcedureReturn
EndIf
Protected *Id=GetGadgetItemData(#LstFile,GetGadgetState(#LstFile))
ChangeCurrentElement(myProject\myFile(),*Id)
DeleteElement(myProject\myFile())
FillsListeFile()
DisableMenuItem(#MainMenu,#M_Save,#True)
EndProcedure
Procedure EventAdd()
gModeNew=#True
OpenAddFile()
SetActiveGadget(#AddFileFileName)
EndProcedure
Procedure EventEdit()
If GetGadgetState(#LstFile)=-1
ProcedureReturn
EndIf
gModeNew=#False
OpenAddFile()
SetActiveGadget(#AddFileFileName)
Protected *Id=GetGadgetItemData(#LstFile,GetGadgetState(#LstFile))
ChangeCurrentElement(myProject\myFile(),*Id)
With myProject\myFile()
SetGadgetText(#AddFileFileName,\name$)
SetGadgetText(#AddFileVersion,\version$)
EndWith
EndProcedure
Procedure EventSaveAs()
BkpFile$=""
EventSave()
EndProcedure
Procedure EventSave()
If BkpFile$=""
BkpFile$=SaveFileRequester(gTxt$(gCurrentLangage,21),"new_project.pke","PB Packer|*.pke",0)
If BkpFile$=""
ProcedureReturn
EndIf
If Right(BkpFile$,4)<>".pke"
BkpFile$+".pke"
EndIf
EndIf
Protected myJson
myJson=CreateJSON(#PB_Any)
If myJson=0
MessageRequester("Json Error","Can not create Json")
BkpFile$=""
ProcedureReturn
EndIf
InsertJSONStructure(JSONValue(myJson),@myProject,project)
If SaveJSON(myJson,BkpFile$,#PB_JSON_PrettyPrint)=0
MessageRequester("Json Error","Can not create a Json File")
BkpFile$=""
ProcedureReturn
EndIf
DisableMenuItem(#MainMenu,#M_Save,#True)
OpenPreferences(gPrefFileName$)
WritePreferenceString("Last_project",BkpFile$)
ClosePreferences()
EndProcedure
Procedure EventOpen()
Protected File$
File$=OpenFileRequester(gTxt$(gCurrentLangage,22),"","PB Packer|*.pke",0)
If File$=""
ProcedureReturn
EndIf
BkpFile$=File$
OpenProject()
EndProcedure
Procedure EventNew()
ClearStructure(@myProject,project)
InitializeStructure(@myProject,project)
ClearGadgetItems(#LstFile)
EndProcedure
Procedure EventExit()
End
EndProcedure
Procedure EventSelectLangage()
Select EventGadget()
Case #BtFr
gCurrentLangage=#Fr
Case #BtEn
gCurrentLangage=#En
EndSelect
CreatePreferences(gPrefFileName$)
WritePreferenceInteger("langage",gCurrentLangage)
ClosePreferences()
CloseWindow(#LangageForm)
OpenMainForm()
EndProcedure
Procedure EventCloseAddForm()
DisableWindow(#MainForm,#False)
CloseWindow(#AddFileForm)
EndProcedure
Procedure EventSelectFile()
Protected FileName$=OpenFileRequester(gTxt$(gCurrentLangage,18),"","*.*|*.*",0)
If FileName$=""
ProcedureReturn
EndIf
SetGadgetText(#AddFileFileName,FileName$)
SetActiveGadget(#AddFileVersion)
EndProcedure
Procedure EventSaveAddForm()
Protected FileName$=GetGadgetText(#AddFileFileName),
FileVesion$=GetGadgetText(#AddFileVersion)
If FileName$=""
MessageRequester(gTxt$(gCurrentLangage,10),gTxt$(gCurrentLangage,15))
ProcedureReturn
EndIf
If FileVesion$=""
MessageRequester(gTxt$(gCurrentLangage,10),gTxt$(gCurrentLangage,16))
ProcedureReturn
EndIf
If FileSize(FileName$)=-1
MessageRequester(gTxt$(gCurrentLangage,10),gTxt$(gCurrentLangage,17))
ProcedureReturn
EndIf
With myProject\myFile()
If gModeNew
AddElement(myProject\myFile())
EndIf
\name$=FileName$
\version$=FileVesion$
EndWith
FillsListeFile()
EventCloseAddForm()
DisableMenuItem(#MainMenu,#M_Save,#False)
EndProcedure
Procedure EventCloseFtpParameters()
DisableWindow(#MainForm,#False)
CloseWindow(#FtpForm)
EndProcedure
Procedure EventSaveFtpParameters()
Protected Server$=GetGadgetText(#FtpName)
Protected User$=GetGadgetText(#FtpUser)
Protected Psw$=GetGadgetText(#FtpPsw)
Protected Port=Val(GetGadgetText(#FtpPort))
Protected Passif.b=GetGadgetState(#FtpPassifMode)
Protected VersionName$=GetGadgetText(#FtpVersion)
Protected PackerName$=GetGadgetText(#FtpPacker)
Protected DirectoryName$=GetGadgetText(#FtpDirectory)
If Server$=""
MessageRequester(gTxt$(gCurrentLangage,23),gTxt$(gCurrentLangage,31))
SetActiveGadget(#FtpName)
ProcedureReturn
EndIf
If User$=""
MessageRequester(gTxt$(gCurrentLangage,23),gTxt$(gCurrentLangage,32))
SetActiveGadget(#FtpUser)
ProcedureReturn
EndIf
If Psw$=""
MessageRequester(gTxt$(gCurrentLangage,23),gTxt$(gCurrentLangage,32))
SetActiveGadget(#FtpPsw)
ProcedureReturn
EndIf
If Port=0
MessageRequester(gTxt$(gCurrentLangage,23),gTxt$(gCurrentLangage,32))
SetActiveGadget(#FtpPort)
ProcedureReturn
EndIf
If VersionName$=""
MessageRequester(gTxt$(gCurrentLangage,23),gTxt$(gCurrentLangage,38))
SetActiveGadget(#FtpVersion)
ProcedureReturn
EndIf
If PackerName$=""
MessageRequester(gTxt$(gCurrentLangage,23),gTxt$(gCurrentLangage,39))
SetActiveGadget(#FtpPacker)
ProcedureReturn
EndIf
If DirectoryName$=""
MessageRequester(gTxt$(gCurrentLangage,23),gTxt$(gCurrentLangage,40))
SetActiveGadget(#FtpDirectory)
ProcedureReturn
EndIf
With myProject
\FtpDirectory$=DirectoryName$
\FtpPasif=Passif
\FtpPort=Port
\FtpPsw$=Psw$
\FtpServer$=Server$
\FtpUser$=User$
\PackerFileName$=PackerName$
\VersionFileName$=VersionName$
EndWith
EventCloseFtpParameters()
DisableMenuItem(#MainMenu,#M_Save,#False)
If gModeSend
gModeSend=#False
EventFtpSend()
EndIf
EndProcedure
Procedure EventFtpParameters()
OpenFtpParameters()
With myProject
SetGadgetText(#FtpName,\FtpServer$)
SetGadgetText(#FtpPacker,\PackerFileName$)
SetGadgetText(#FtpDirectory,\FtpDirectory$)
SetGadgetState(#FtpPassifMode,\FtpPasif)
SetGadgetText(#FtpUser,\FtpUser$)
SetGadgetText(#FtpPsw,\FtpPsw$)
SetGadgetText(#FtpVersion,\VersionFileName$)
SetGadgetText(#FtpPort,Str(\FtpPort))
EndWith
EndProcedure
Procedure EventFtpSend()
Protected IdFile,FileName,Values$,IdFtp,IdPack
With myProject
If \FtpServer$="" Or \FtpUser$="" Or \FtpPsw$="" Or \FtpPort=0 Or \FtpDirectory$="" Or
\PackerFileName$="" Or \VersionFileName$=""
gModeSend=#True
EventFtpParameters()
ProcedureReturn
EndIf
If Right(\PackerFileName$,4)<>".zip"
\PackerFileName$+".zip"
EndIf
UseZipPacker()
IdPack=CreatePack(#PB_Any,\PackerFileName$)
If IdPack=0
MessageRequester("Packer Error","Canot create packer file")
ProcedureReturn
EndIf
Values$=\PackerFileName$+Chr(10)
ForEach \myFile()
If AddPackFile(IdPack,\myFile()\name$,GetFilePart(\myFile()\name$))=0
MessageRequester("Packer Error","Canot add file to packer file")
ClosePack(IdPack)
DeleteFile(\PackerFileName$)
ProcedureReturn
EndIf
Values$+GetFilePart(\myFile()\name$)+"@"
Values$+\myFile()\version$
Values$+Chr(10)
Next
ClosePack(IdPack)
IdFile=CreateFile(#PB_Any,\VersionFileName$)
WriteString(IdFile,Values$)
CloseFile(IdFile)
InitNetwork()
IdFtp=OpenFTP(#PB_Any,\FtpServer$,\FtpUser$,\FtpPsw$,\FtpPasif,\FtpPort)
If IdFtp=0
MessageRequester("Ftp Error","Canot open Ftp connection")
DeleteFile(\PackerFileName$)
DeleteFile(\VersionFileName$)
ProcedureReturn
EndIf
If SetFTPDirectory(IdFtp,\FtpDirectory$)=0
MessageRequester("Ftp Error","Canot open Ftp directory")
DeleteFile(\PackerFileName$)
DeleteFile(\VersionFileName$)
ProcedureReturn
EndIf
If SendFTPFile(IdFtp,\VersionFileName$,\VersionFileName$)=0
MessageRequester("Ftp Error","Canot send version file")
DeleteFile(\PackerFileName$)
DeleteFile(\VersionFileName$)
ProcedureReturn
EndIf
If SendFTPFile(IdFtp,\PackerFileName$,\PackerFileName$)=0
MessageRequester("Ftp Error","Canot send version file")
DeleteFile(\PackerFileName$)
DeleteFile(\VersionFileName$)
ProcedureReturn
EndIf
DeleteFile(\PackerFileName$)
DeleteFile(\VersionFileName$)
MessageRequester(gTxt$(gCurrentLangage,41),gTxt$(gCurrentLangage,42))
EndWith
EndProcedure
;}
;-* Form Management
Procedure OpenLangageForm()
OpenWindow(#LangageForm,0,0,400,90,#Title,#PB_Window_ScreenCentered)
ButtonGadget(#BtFr,10,10,380,30,gTxt$(#Fr,0))
ButtonGadget(#BtEn,10,50,380,30,gTxt$(#En,0))
SetGadgetFont(#BtFr,FontID(#ArialM))
SetGadgetFont(#BtEn,FontID(#ArialM))
BindEvent(#PB_Event_Gadget,@EventSelectLangage(),#LangageForm)
EndProcedure
Procedure OpenMainForm()
Protected Flag=#PB_Window_Maximize|#PB_Window_MaximizeGadget|#PB_Window_ScreenCentered|
#PB_Window_SystemMenu|#PB_Window_MinimizeGadget|#PB_Window_SizeGadget
OpenWindow(#MainForm,0,0,800,600,#Title,Flag)
;{ Menu Management
CreateMenu(#MainMenu,WindowID(#MainForm))
MenuTitle(gTxt$(gCurrentLangage,1))
MenuItem(#M_New,gTxt$(gCurrentLangage,5))
AddKeyboardShortcut(#MainForm,#PB_Shortcut_Control|#PB_Shortcut_N,#M_New)
BindMenuEvent(#MainMenu,#M_New,@EventNew())
MenuItem(#M_Open,gTxt$(gCurrentLangage,2))
AddKeyboardShortcut(#MainForm,#PB_Shortcut_Control|#PB_Shortcut_O,#M_Open)
BindMenuEvent(#MainMenu,#M_Open,@EventOpen())
MenuItem(#M_Save,gTxt$(gCurrentLangage,3))
AddKeyboardShortcut(#MainForm,#PB_Shortcut_Control|#PB_Shortcut_S,#M_Save)
BindMenuEvent(#MainMenu,#M_Save,@EventSave())
MenuItem(#M_SaveAs,gTxt$(gCurrentLangage,4))
BindMenuEvent(#MainMenu,#M_SaveAs,@EventSaveAs())
MenuBar()
MenuItem(#M_Exit,gTxt$(gCurrentLangage,6))
BindMenuEvent(#MainMenu,#M_Exit,@EventExit())
MenuTitle(gTxt$(gCurrentLangage,7))
MenuItem(#M_AddFile,gTxt$(gCurrentLangage,8))
AddKeyboardShortcut(#MainForm,#PB_Shortcut_Alt|#PB_Shortcut_A,#M_AddFile)
BindMenuEvent(#MainMenu,#M_AddFile,@EventAdd())
MenuItem(#M_RemoveFile,gTxt$(gCurrentLangage,9))
AddKeyboardShortcut(#MainForm,#PB_Shortcut_Delete,#M_RemoveFile)
BindMenuEvent(#MainMenu,#M_RemoveFile,@EventRemove())
MenuItem(#M_EditFile,gTxt$(gCurrentLangage,19))
AddKeyboardShortcut(#MainForm,#PB_Shortcut_Alt|#PB_Shortcut_E,#M_EditFile)
BindMenuEvent(#MainMenu,#M_EditFile,@EventEdit())
MenuTitle("Ftp")
MenuItem(#M_FtpParameter,gTxt$(gCurrentLangage,23))
BindMenuEvent(#MainMenu,#M_FtpParameter,@EventFtpParameters())
MenuItem(#M_FtpSend,gTxt$(gCurrentLangage,29))
BindMenuEvent(#MainMenu,#M_FtpSend,@EventFtpSend())
;}
;{ Gadget Management
Protected WF=WindowWidth(#MainForm),
HF=WindowHeight(#MainForm),
M=10,WL=(WF-(M*2)),HL=(HF-(M*4)),X=M,Y=M
ListIconGadget(#LstFile,X,Y,WL,HL,gTxt$(gCurrentLangage,7),WL*0.7,#PB_ListIcon_GridLines|#PB_ListIcon_FullRowSelect)
AddGadgetColumn(#LstFile,1,"Version",(WL*0.3)-5)
SetGadgetFont(#LstFile,FontID(#ArialM))
;}
BindEvent(#PB_Event_CloseWindow,@EventExit(),#MainForm)
BindEvent(#PB_Event_SizeWindow,@EventSize(),#MainForm)
EndProcedure
Procedure OpenAddFile()
Protected Flag=#PB_Window_ScreenCentered|#PB_Window_SystemMenu,
W=280,M=10,H=30,WF=W+(M*2),HF=(H*5)+(M*6),X=M,Y=M,tmp,WB=30,idTitle
If gModeNew
idTitle=10
Else
idTitle=20
EndIf
DisableWindow(#MainForm,#True)
OpenWindow(#AddFileForm,0,0,WF,HF,gTxt$(gCurrentLangage,idTitle),Flag,WindowID(#MainForm))
BindEvent(#PB_Event_CloseWindow,@EventCloseAddForm(),#AddFileForm)
tmp=TextGadget(#PB_Any,X,Y,W,H,gTxt$(gCurrentLangage,11))
SetGadgetFont(tmp,FontID(#ArialM))
Y+H
StringGadget(#AddFileFileName,X,Y,W-(WB+M),H,"")
SetGadgetFont(#AddFileFileName,FontID(#ArialM))
ButtonGadget(#AddFileExploreur,WF-(WB+M),Y,WB,H,"...")
Y+H+M
tmp=TextGadget(#PB_Any,X,Y,W,H,gTxt$(gCurrentLangage,12))
SetGadgetFont(tmp,FontID(#ArialM))
Y+H
StringGadget(#AddFileVersion,X,Y,W,H,"")
SetGadgetFont(#AddFileVersion,FontID(#ArialM))
Y+H+M+M
W=(W/2)-M
ButtonGadget(#AddFileSubmit,X,Y,W,H,gTxt$(gCurrentLangage,13))
SetGadgetFont(#AddFileSubmit,FontID(#ArialM))
X+W+M
ButtonGadget(#AddFileChancel,X,Y,W,H,gTxt$(gCurrentLangage,14))
SetGadgetFont(#AddFileChancel,FontID(#ArialM))
BindGadgetEvent(#AddFileChancel,@EventCloseAddForm())
AddKeyboardShortcut(#AddFileForm,#PB_Shortcut_Escape,$FF)
BindEvent(#PB_Event_Menu,@EventCloseAddForm(),#AddFileForm,$FF)
AddKeyboardShortcut(#AddFileForm,#PB_Shortcut_Return,$FF1)
BindEvent(#PB_Event_Menu,@EventSaveAddForm(),#AddFileForm,$FF1)
BindGadgetEvent(#AddFileSubmit,@EventSaveAddForm())
BindGadgetEvent(#AddFileExploreur,@EventSelectFile())
EndProcedure
Procedure OpenFtpParameters()
Protected Flag=#PB_Window_ScreenCentered|#PB_Window_SystemMenu,
W=280,M=10,H=30,WF=W+(M*2),HF=(H*17)+(M*8),X=M,Y=M,tmp,WB=30
DisableWindow(#MainForm,#True)
OpenWindow(#FtpForm,0,0,WF,HF,gTxt$(gCurrentLangage,23),Flag,WindowID(#MainForm))
BindEvent(#PB_Event_CloseWindow,@EventCloseFtpParameters(),#FtpForm)
tmp=TextGadget(#PB_Any,X,Y,W,H,gTxt$(gCurrentLangage,24))
SetGadgetFont(tmp,FontID(#ArialM))
Y+H
StringGadget(#FtpName,X,Y,W,H,"")
SetGadgetFont(#FtpName,FontID(#ArialM))
Y+H+M
tmp=TextGadget(#PB_Any,X,Y,W,H,gTxt$(gCurrentLangage,25))
SetGadgetFont(tmp,FontID(#ArialM))
Y+H
StringGadget(#FtpUser,X,Y,W,H,"")
SetGadgetFont(#FtpUser,FontID(#ArialM))
Y+H+M
tmp=TextGadget(#PB_Any,X,Y,W,H,gTxt$(gCurrentLangage,26))
SetGadgetFont(tmp,FontID(#ArialM))
Y+H
StringGadget(#FtpPsw,X,Y,W,H,"")
SetGadgetFont(#FtpPsw,FontID(#ArialM))
Y+H+M
tmp=TextGadget(#PB_Any,X,Y,W,H,gTxt$(gCurrentLangage,30))
SetGadgetFont(tmp,FontID(#ArialM))
Y+H
StringGadget(#FtpDirectory,X,Y,W,H,"")
SetGadgetFont(#FtpDirectory,FontID(#ArialM))
Y+H+M
tmp=TextGadget(#PB_Any,X,Y,W,H,gTxt$(gCurrentLangage,27))
SetGadgetFont(tmp,FontID(#ArialM))
Y+H
StringGadget(#FtpPort,X,Y,W,H,"")
SetGadgetFont(#FtpPort,FontID(#ArialM))
Y+H+M
CheckBoxGadget(#FtpPassifMode,X,Y,W,H,gTxt$(gCurrentLangage,28))
SetGadgetFont(#FtpPassifMode,FontID(#ArialM))
Y+H+M
tmp=TextGadget(#PB_Any,X,Y,W,H,gTxt$(gCurrentLangage,36))
SetGadgetFont(tmp,FontID(#ArialM))
Y+H
StringGadget(#FtpVersion,X,Y,W,H,"")
SetGadgetFont(#FtpVersion,FontID(#ArialM))
Y+H+M
tmp=TextGadget(#PB_Any,X,Y,W,H,gTxt$(gCurrentLangage,37))
SetGadgetFont(tmp,FontID(#ArialM))
Y+H
StringGadget(#FtpPacker,X,Y,W,H,"")
SetGadgetFont(#FtpPacker,FontID(#ArialM))
Y+H+M+M
W=(W/2)-M
ButtonGadget(#FtpSubmit,X,Y,W,H,gTxt$(gCurrentLangage,13))
SetGadgetFont(#FtpSubmit,FontID(#ArialM))
X+W+M
ButtonGadget(#FtpChancel,X,Y,W,H,gTxt$(gCurrentLangage,14))
SetGadgetFont(#FtpChancel,FontID(#ArialM))
BindGadgetEvent(#FtpSubmit,@EventSaveFtpParameters())
BindGadgetEvent(#FtpChancel,@EventCloseFtpParameters())
EndProcedure
;}
;-* Runing
If OpenPreferences(gPrefFileName$)=0
OpenLangageForm()
Else
gCurrentLangage=ReadPreferenceInteger("langage",0)
OpenMainForm()
If ReadPreferenceString("Last_project","")<>""
BkpFile$=ReadPreferenceString("Last_project","")
OpenProject()
EndIf
EndIf
;}
;-* Main loop
Repeat :WaitWindowEvent():ForEver
;}
ATTENTION: ne fonctionne pas avec PB:5.40
Code : Tout sélectionner
;**********************************************************************************************************
; Author : MicrodevWeb
; Name : PbLauncher
;{ Historique of version
;{ ------ Version : B0.01 Create: 2015/10/30 Finished :
; -------- Fist beta version
;}
;}
; Use PB 5.31
;**********************************************************************************************************
;-* Global variables
;Adress of your Ftp server account ex: microdevweb.com
Global Server$=
; user name for this Ftp server account
Global User$=
; password for this Ftp server account
Global Psw$=
; Name of version file
Global VersionName$=
; Directory of is located file version ans zip
Global Directory$=
; PassifMode
Global PassifMode.b=#True
; Port Ftp
Global Port=21
; No empty if you want run after exact file
Global ExeToRun$=""
Global IdFtp,Exit.b=#False
;}
Procedure OpenConnection()
InitNetwork()
IdFtp=OpenFTP(#PB_Any,Server$,User$,Psw$,PassifMode,Port)
If IdFtp=0
MessageRequester("Ftp Error","Canot open Ftp connection")
End
EndIf
If SetFTPDirectory(IdFtp,Directory$)=0
MessageRequester("Ftp Error","Canot open Ftp directory")
End
EndIf
EndProcedure
Procedure MajAll()
OpenConnection()
If ReceiveFTPFile(IdFtp,VersionName$,"LocalVersion.ver")=0
MessageRequester("Ftp Error","Canot dowload version file")
End
EndIf
IdLocalVersion=OpenFile(#PB_Any,"LocalVersion.ver")
LocalValues$=ReadString(IdLocalVersion,#PB_File_IgnoreEOL)
FilePack$=StringField(LocalValues$,1,Chr(10))
CloseFile(IdLocalVersion)
If ReceiveFTPFile(IdFtp,FilePack$,FilePack$)=0
CloseFTP(IdFtp)
DeleteFile(FilePack$)
MessageRequester("Ftp Error","Canot dowload Zip file")
End
EndIf
UseZipPacker()
IdPack=OpenPack(#PB_Any,FilePack$)
If IdPack=0
CloseFTP(IdFtp)
MessageRequester("unzip Error","Canot open Zip file")
End
EndIf
If ExaminePack(IdPack)
While NextPackEntry(IdPack)
If UncompressPackFile(IdPack,PackEntryName(IdPack),PackEntryName(IdPack))=0
ClosePack(IdPack)
DeleteFile(FilePack$)
MessageRequester("unzip Error","Canot uncompress file"+PackEntryName(IdPack))
End
EndIf
Wend
ClosePack(IdPack)
DeleteFile(FilePack$)
CloseFTP(IdFtp)
Else
ClosePack(IdPack)
DeleteFile(FilePack$)
CloseFTP(IdFtp)
MessageRequester("unzip Error","Canot open Zip file")
End
EndIf
If ExeToRun$<>""
RunProgram(ExeToRun$)
Else
MessageRequester("Lancher","UnZip success")
EndIf
EndProcedure
Procedure MajLocal()
OpenConnection()
If ReceiveFTPFile(IdFtp,VersionName$,"ServerVersion.ver")=0
MessageRequester("Ftp Error","Canot dowload version file")
End 0
EndIf
IdLocalVersion=OpenFile(#PB_Any,"LocalVersion.ver")
LocalValues$=ReadString(IdLocalVersion,#PB_File_IgnoreEOL)
FilePack$=StringField(LocalValues$,1,Chr(10))
CloseFile(IdLocalVersion)
IdServerVersion=OpenFile(#PB_Any,"ServerVersion.ver")
ServerValues$=ReadString(IdServerVersion,#PB_File_IgnoreEOL)
FilePack$=StringField(LocalValues$,1,Chr(10))
CloseFile(IdServerVersion)
DeleteFile("ServerVersion.ver")
NbL=CountString(LocalValues$,Chr(10))
NbS=CountString(ServerValues$,Chr(10))
For N=2 To NbL+1
LocalVer$=StringField(StringField(LocalValues$,N,Chr(10)),2,"@")
ServerVer$=StringField(StringField(ServerValues$,N,Chr(10)),2,"@")
File$=StringField(StringField(ServerValues$,N,Chr(10)),1,"@")
If LocalVer$<>ServerVer$
If FileSize(FilePack$)=-1
If LocalVer$<>ServerVer$
If ReceiveFTPFile(IdFtp,FilePack$,FilePack$)=0
CloseFTP(IdFtp)
DeleteFile(FilePack$)
MessageRequester("Ftp Error","Canot dowload Zip file")
End
EndIf
EndIf
UseZipPacker()
IdPack=OpenPack(#PB_Any,FilePack$)
EndIf
If UncompressPackFile(IdPack,File$,File$)=0
MessageRequester("unzip Error","Canot uncompress file"+PackEntryName(IdPack))
ClosePack(IdPack)
DeleteFile(FilePack$)
End
EndIf
EndIf
Next
If FileSize(FilePack$)<>-1
ClosePack(IdPack)
DeleteFile(FilePack$)
EndIf
End
EndProcedure
Procedure UpdateAvailable()
OpenConnection()
If ReceiveFTPFile(IdFtp,VersionName$,"ServerVersion.ver")=0
MessageRequester("Ftp Error","Canot dowload version file")
End 0
EndIf
IdLocalVersion=OpenFile(#PB_Any,"LocalVersion.ver")
LocalValues$=ReadString(IdLocalVersion,#PB_File_IgnoreEOL)
FilePack$=StringField(LocalValues$,1,Chr(10))
CloseFile(IdLocalVersion)
IdServerVersion=OpenFile(#PB_Any,"ServerVersion.ver")
ServerValues$=ReadString(IdServerVersion,#PB_File_IgnoreEOL)
FilePack$=StringField(LocalValues$,1,Chr(10))
CloseFile(IdServerVersion)
DeleteFile("ServerVersion.ver")
NbL=CountString(LocalValues$,Chr(10))
NbS=CountString(ServerValues$,Chr(10))
If NbL<>NbS
End 1
EndIf
For N=2 To NbL+1
LocalVer$=StringField(StringField(LocalValues$,N,Chr(10)),2,"@")
ServerVer$=StringField(StringField(ServerValues$,N,Chr(10)),2,"@")
If LocalVer$<>ServerVer$
End 2
EndIf
Next
End 0
EndProcedure
Select ProgramParameter(0)
Case "UpdateAvailable"
UpdateAvailable()
Case "MajAll"
MajAll()
Case "MajLocal"
MajLocal()
EndSelect
If FileSize("LocalVersion.ver")=-1
MajAll()
End
EndIf
Code : Tout sélectionner
idPrg=RunProgram("Lancher.exe","UpdateAvailable","",#PB_Program_Open|#PB_Program_Read,#PB_Program_Connect)
Repeat
If ProgramRunning(idPrg)=0
Select ProgramExitCode(idPrg)
Case 0
Break
Case 1 ; Un nouveau module a été ajouté, met a jour tout
If MessageRequester("Nouvelle version disponible","Voulez-vous l'installer?",#PB_MessageRequester_YesNo)=#PB_MessageRequester_Yes
idPrg=RunProgram("Lancher.exe","MajAll","",#PB_Program_Open|#PB_Program_Read,#PB_Program_Connect)
End
Else
Break
EndIf
Case 2
If MessageRequester("Nouvelle version disponible","Voulez-vous l'installer?",#PB_MessageRequester_YesNo)=#PB_MessageRequester_Yes
idPrg=RunProgram("Lancher.exe","MajLocal","",#PB_Program_Open|#PB_Program_Read,#PB_Program_Connect)
End
Else
Break
EndIf
EndSelect
EndIf
ForEver
End