Page 1 of 1

CreateFileForce(#File,Filename$)

Posted: Fri Jan 27, 2006 1:44 am
by Flype
Code updated for 5.20+

This function create a file, just like CreateFile() does.
But if the folders specified in Filename$ doesn't exists, the function try to create them.

Code: Select all

Procedure CreateFileForce(FileId, FileName.s)
  
  Protected FolderExist, FolderNumber, FolderIndex, Directory
  Protected PathName.s, BufferName.s, FolderName.s, FolderNext.s
  
  PathName = LCase(GetPathPart(FileName))
  
  Repeat
    FolderIndex + 1
    FolderName = StringField(PathName,FolderIndex,"\")
    If FolderName
      BufferName + FolderName + "\"
      Directory = ExamineDirectory(#PB_Any,BufferName,"")
      If Directory
        FolderNext = StringField(PathName,FolderIndex+1,"\")
        If FolderNext
          While NextDirectoryEntry(Directory)
            If DirectoryEntryType(Directory) = #PB_DirectoryEntry_Directory
              If DirectoryEntryName(Directory) = FolderNext
                FolderNumber + 1
                FolderExist = #True
              EndIf
            EndIf
          Wend
          
          If FolderExist
            FolderExist = #False
          Else
            If CreateDirectory(BufferName+FolderNext)
              Debug ReplaceString("Folder '%s' created","%s",BufferName+FolderNext)
              FolderNumber + 1
            Else
              Debug ReplaceString("Folder '%s' not created","%s",BufferName+FolderNext)
              Break
            EndIf
          EndIf
        EndIf
        
        FinishDirectory(Directory)
      EndIf
    Else
      Break
    EndIf
  ForEver
  
  If (FolderIndex-1) = (FolderNumber+1)
    ProcedureReturn CreateFile(FileId, FileName)
  EndIf
  
EndProcedure

; Test

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

If CreateFileForce(0,fichier$)
  Debug ReplaceString("File '%s' created","%s",fichier$)
  WriteStringN(0, "Demonstration of CreateFileEx(#File,FileName$)")
  WriteStringN(0, "")
  WriteStringN(0, "Path of this file :")
  WriteStringN(0, fichier$)
  CloseFile(0)
  RunProgram("notepad",fichier$,GetPathPart(fichier$))
Else
  Debug ReplaceString("File '%s' not created","%s",fichier$)
EndIf
Works perfect for me, Tested on XP, Shouldn't be bugged.

Regards

Posted: Fri Jan 27, 2006 11:03 am
by josku_x
Just what I needed :D

Thanks! That is great piece of code.

Posted: Fri Jan 27, 2006 11:07 am
by gnozal
Another possibility :

Code: Select all

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

Posted: Fri Jan 27, 2006 3:34 pm
by utopiomania
MakeSureDirectoryPathExists_() is exported by DbgHelp.dll? I'm not shure if it's present on all 9x systems, or even NT? Do you know, Gnozal?

In the meantime here's what I use for a similar task. It copies files, but creates directories on the fly if they don't exist:

Code: Select all

Procedure CopyCreateEntry(Src.s, Dst.s) 
  For I = 1 To Len(Dst) 
    If Mid(Dst, I, 1) = "\" 
      CreateDirectory(Left(Dst, I))    
    EndIf 
  Next 
  CopyFile(Src, Dst) 
EndProcedure 

Posted: Fri Jan 27, 2006 4:26 pm
by MikeB
In Flype's code the line

Code: Select all

PathName = LCase(GetPathPart(FileName))
prevented it working for me when the filepath was partly already existing in upper case. E.g. "F:\MYTEMP\newdir\test.txt" when "F:\MYTEMP" already exists. I removed the LCase() and it now works perfectly.

Posted: Fri Jan 27, 2006 8:34 pm
by Flype
utopiomania wrote:MakeSureDirectoryPathExists_() is exported by DbgHelp.dll? I'm not shure if it's present on all 9x systems, or even NT? Do you know, Gnozal?

In the meantime here's what I use for a similar task. It copies files, but creates directories on the fly if they don't exist:

Code: Select all

Procedure CopyCreateEntry(Src.s, Dst.s) 
  For I = 1 To Len(Dst) 
    If Mid(Dst, I, 1) = "" 
      CreateDirectory(Left(Dst, I))    
    EndIf 
  Next 
  CopyFile(Src, Dst) 
EndProcedure 
thank you man, your code is much much better.
So i rewrite my function using your logic :

Code: Select all

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
In my first post, my logic was to create a directory only if (after re-examining folder) the folder doesn't exists.
Your logic is to re-create the directory even if it already exists. much shorter. :)

Posted: Fri Jan 27, 2006 10:56 pm
by PB
> MakeSureDirectoryPathExists_() is exported by DbgHelp.dll? I'm not shure
> if it's present on all 9x systems, or even NT?

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).

Posted: Sat Jan 28, 2006 9:41 am
by Flype
we can also use SHCreateDirectoryEx http://www.mentalis.org/apilist/SHCreat ... ryEx.shtml

Posted: Sat Jan 28, 2006 9:58 am
by PB
But: 9x/ME: Not supported, and besides, it only creates one folder, and not nested folders.