CreateFileEx() : Création d'un fichier ET des dossiers

Partagez votre expérience de PureBasic avec les autres utilisateurs.
Avatar de l’utilisateur
Flype
Messages : 2431
Inscription : jeu. 29/janv./2004 0:26
Localisation : Nantes

CreateFileEx() : Création d'un fichier ET des dossiers

Message par Flype »

Cette procédure réagit comme la commande CreateFile() de Purebasic. Elle a les même paramêtres et le même résultat. A la différence que si les dossiers du chemin n'existent pas, CreateFileEx() tente de les créer. A priori çà marche bien, à voir s'il n'y a pas un petit bug ou deux, mais je n'en ai pas repéré.

Code : Tout sélectionner

Procedure.l CreateFileEx(FileId.l,FileName.s)
  
  ; Syntax:
  ; CreateFileEx(#File,FileName$)
  ; 
  ; Auteur:
  ; Flype (flype@altern.org)
  ; 
  ; Description:
  ; Créé un fichier vide comme la commande CreateFile() de Purebasic.
  ; Si le chemin n'existe pas, CreateFileEx() tente de le créer.
  
  
  Protected FileId.l, FolderExist.l, FolderNumber.l, FolderIndex.l
  Protected FileName.s, PathName.s, BufferName.s, FolderName.s, FolderNext.s
  
  PathName = LCase(GetPathPart(FileName))
  
  Repeat
    FolderIndex + 1
    FolderName = StringField(PathName,FolderIndex,"\")
    If FolderName
      BufferName + FolderName + "\"
      If ExamineDirectory(#PB_Any,BufferName,"")
        FolderNext = StringField(PathName,FolderIndex+1,"\")
        If FolderNext
          Repeat
            Select NextDirectoryEntry()
              Case 0
                Break
              Case 2
                If DirectoryEntryName() = FolderNext
                  FolderNumber + 1
                  FolderExist = #True
                EndIf
            EndSelect
          ForEver
          If FolderExist
            FolderExist = #False
          Else
            If CreateDirectory(BufferName+FolderNext)
              Debug ReplaceString("Dossier '%s' créé","%s",BufferName+FolderNext)
              FolderNumber + 1
            Else
              Debug ReplaceString("Dossier '%s' non créé","%s",BufferName+FolderNext)
              Break
            EndIf
          EndIf
        EndIf
      EndIf
    Else
      Break
    EndIf
  ForEver
  
  If (FolderIndex-1) = (FolderNumber+1)
    ProcedureReturn CreateFile(FileId,FileName)
  EndIf
  
EndProcedure

; Test

fichier$ = "C:\Mes Sources\Mes Tests\Temp\Temp2\fichier.txt"

If CreateFileEx(0,fichier$)
  Debug ReplaceString("Fichier '%s' créé","%s",fichier$)
  WriteStringN("Démonstration de CreateFileEx(#File,FileName$)")
  WriteStringN("")
  WriteStringN("Chemin de ce fichier :")
  WriteStringN(fichier$)
  CloseFile(0)
  RunProgram("notepad",fichier$,GetPathPart(fichier$))
Else
  Debug ReplaceString("Fichier '%s' non créé","%s",fichier$)
EndIf
Image
Dr. Dri
Messages : 2527
Inscription : ven. 23/janv./2004 18:10

Message par Dr. Dri »

tu pourrais aussi ajouter un test avec IsFilename() ?

Dri ;)
gnozal
Messages : 832
Inscription : mar. 07/déc./2004 17:35
Localisation : France
Contact :

Message par gnozal »

Autre possibilité :

Code : Tout sélectionner

Procedure.l CreateFileEx(FileId.l, FileName.s)
  MakeSureDirectoryPathExists_(FileName)
  ProcedureReturn CreateFile(FileId,FileName)
EndProcedure

If CreateFileEx(0, "c:\toto\toto\toto.txt")
  WriteStringN("toto")
  CloseFile(0)
EndIf
Backup
Messages : 14526
Inscription : lun. 26/avr./2004 0:40

Message par Backup »

pour le coup , je prefere la version a Gnozal :lol:

dommage Flype c'etait bien vu (mais un peut long... ) :D
nico
Messages : 3702
Inscription : ven. 13/févr./2004 0:57

Message par nico »

Tu as win98, parce que je ne suis pas sûr que ça fonctionne avec toutes les fonctions de windows.
Dr. Dri
Messages : 2527
Inscription : ven. 23/janv./2004 18:10

Message par Dr. Dri »

nico a écrit :Tu as win98, parce que je ne suis pas sûr que ça fonctionne avec toutes les fonctions de windows.
Je confirme pour 98

Dri ;)
Avatar de l’utilisateur
Chris
Messages : 3731
Inscription : sam. 24/janv./2004 14:54
Contact :

Message par Chris »

Dr. Dri a écrit :
nico a écrit :Tu as win98, parce que je ne suis pas sûr que ça fonctionne avec toutes les fonctions de windows.
Je confirme pour 98

Dri ;)
¨
Pas obligatoire que ça fonctionne chez tout le monde du premier coup.
Requirements
Client: Included in Windows XP and Windows 2000 Professional.
Server: Included in Windows Server 2003 and Windows 2000 Server.
Redistributable: Requires DbgHelp.dll on Windows NT 4.0 and Windows Me/98/95.
Header: Declared in Dbghelp.h.
Library: Use Dbghelp.lib.
PS : Je parle de la version de Gnozal
Avatar de l’utilisateur
Flype
Messages : 2431
Inscription : jeu. 29/janv./2004 0:26
Localisation : Nantes

Message par Flype »

:lol: gnozal :2gunfire: flype

je connaissais pas du tout MakeSureDirectoryPathExists_()
ni SHCreateDirectoryEx_() que je viens de découvrir en regardant sur msdn.
http://msdn.microsoft.com/library/defau ... toryex.asp
Image
Avatar de l’utilisateur
Flype
Messages : 2431
Inscription : jeu. 29/janv./2004 0:26
Localisation : Nantes

Message par Flype »

le mieux c'est encore çà, beaucoup plus court c'est clair et compatible avec tout à priori (que des fonctions purebasic) :

Code : Tout sélectionner

Procedure CreateFileForce(FileId.l,FileName.s) 
  For i = 1 To Len(FileName) 
    If Mid(FileName,i,1) = "\" 
      CreateDirectory(Left(FileName,i)) 
    EndIf 
  Next 
  ProcedureReturn CreateFile(FileId,FileName) 
EndProcedure 

fichier$ = "C:\My Sources\My Purebasics\Temp\Temp2\testfile.txt" 

If CreateFileForce(0,fichier$) 
  Debug ReplaceString("File '%s' created","%s",fichier$) 
  WriteStringN("Demonstration of CreateFileForce(#File,FileName$)") 
  WriteStringN("") 
  WriteStringN("Path of this file :") 
  WriteStringN(fichier$) 
  CloseFile(0) 
  RunProgram("notepad",fichier$,GetPathPart(fichier$)) 
Else 
  Debug ReplaceString("File '%s' not created","%s",fichier$) 
EndIf
utopiomania du forum anglais m'a donné LA solution. :P
Image
Avatar de l’utilisateur
Chris
Messages : 3731
Inscription : sam. 24/janv./2004 14:54
Contact :

Message par Chris »

Il doit bien y avoir une bonne demi douzaine de façons de faire.

J'avais fait ça, il y a un moment. Ca avait l'air de fonctionner aussi

Code : Tout sélectionner

Procedure CreateFullPath(FileId.l,FileName.s) 
  Repeat
    a$ + StringField(FileName, i+1, "\")+"\" : i+1
    k = CreateDirectory(a$)
  Until i = CountString(FileName, "\")
  
  k = CreateFile(FileId, a$ + GetFilePart(FileName))
  ProcedureReturn k
EndProcedure 


fichier$ = "C:\Test1\Test2\Test3\Test4\Test5\Test.txt" 

If CreateFullPath(0, fichier$)
  MessageRequester("","Le fichier est créé")
Else
  MessageRequester("","Le fichier n'est pas créé")
EndIf
gnozal
Messages : 832
Inscription : mar. 07/déc./2004 17:35
Localisation : France
Contact :

Message par gnozal »

Chris a écrit :
Dr. Dri a écrit :
nico a écrit :Tu as win98, parce que je ne suis pas sûr que ça fonctionne avec toutes les fonctions de windows.
Je confirme pour 98

Dri ;)
¨
Pas obligatoire que ça fonctionne chez tout le monde du premier coup.
Requirements
Client: Included in Windows XP and Windows 2000 Professional.
Server: Included in Windows Server 2003 and Windows 2000 Server.
Redistributable: Requires DbgHelp.dll on Windows NT 4.0 and Windows Me/98/95.
Header: Declared in Dbghelp.h.
Library: Use Dbghelp.lib.
PS : Je parle de la version de Gnozal
Sur le forum anglais :
PB a écrit :http://www.mentalis.org/apilist/MakeSur ... ists.shtml says it's present from Windows NT 3.1 or later and Windows 95 or later, but looking at MSDN it says different, so I just tested it on clean installs of Win 95b, 98se, ME and NT4, and yes, it worked on each. (Note: I didn't check if DbgHelp.dll was present on them; I just tested if MakeSureDirectoryPathExists_("c:\x\y\z") worked from a compiled exe, and it did).
Répondre