Accéder au fichiers de n'importe quelle taille sans fso et sans open "" as

2/5 (15 avis)

Vue 4 483 fois - Téléchargée 377 fois

Description

Ma source permet d'écrire, et de lire des fichiers de N'IMPORTE QUELLE TAILLE juste avec des APIS. IL Y A "0" FSO. C'est assez stable et simple. Je l'ai testé non compilé mais il semble vite. Il y a un programme d'exemple. La seule chose qui manque pour qu'il soit identique à TextStream, c'est pourvoir ouvir des fichier en mode "For appending". Si vous savez comment, dites-moi le SVP.

Source / Exemple :


'DANS UN USERCONTROL APPELÉ" TextStream"

'Super Lecteur de fichiers
'Fait par Gabriel Champagne le 8 décembre 2003
'Vous êtes autorisé à copier et distribuer cette source
'JE NE PEUX EN AUCUN CAS ÊTRE RESPONSABLE DE DOMMAGES ÉVENTUELS DE TOUTE FORME

Public Event ReadWizzardData(Data As String, Percent As Long)
Public Event ReadWizzardFinish()
Public Event Error(Number As Errors)
Private Declare Function FileExists Lib "shell32" Alias "#45" (ByVal szPath As String) As Long
Private Declare Function CreateFile_ Lib "kernel32" Alias "CreateFileA" (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, ByVal lpSecurityAttributes As Any, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function SetFilePointer Lib "kernel32" (ByVal hfile As Long, ByVal lDistanceToMove As Long, lpDistanceToMoveHigh As Long, ByVal dwMoveMethod As Long) As Long
Private Declare Function SetEndOfFile Lib "kernel32" (ByVal hfile As Long) As Long
Private Declare Function WriteFile Lib "kernel32" (ByVal hfile As Long, lpBuffer As Any, ByVal nNumberOfBytesToWrite As Long, lpNumberOfBytesWritten As Long, ByVal lpOverlapped As Any) As Long
Private Declare Function ReadFile Lib "kernel32" (ByVal hfile As Long, lpBuffer As Any, ByVal nNumberOfBytesToRead As Long, lpNumberOfBytesRead As Long, ByVal lpOverlapped As Any) As Long
Private Declare Function GetFileSize Lib "kernel32" (ByVal hfile As Long, lpFileSizeHigh As Long) As Long
Public Enum Errors
    EndOfFileReached = 1
    CannotOpenFile = 2
    BadFileMode = 3
    Unknown = 4
    FileAleardyExist = 5
    WizzardIsRunning = 6
    UnknownMethod = 7
    CannotCreateFile = 8
    InvalidStartPosition = 9
    InvalidNumber = 10
End Enum
Public Enum ShareMode
    FILE_SHARE_READ = 1
    FILE_SHARE_WRITE = 2
End Enum
Public Enum FileDisposition
    CREATE_NEW = 1
    OPEN_EXISTING = 3
End Enum
Public Enum IOMode
    ForReading = -2147483648#
    ForWritting = 1073741824
    ForAppending = -1073741824
End Enum
Public Enum FilePosition
The_Begin = -1
The_End = -2
End Enum
Private Const FILE_BEGIN = 0
Private Const FILE_END = 2
Private total As Long
Private rendu As Long
Private ca As Boolean
Private mbus As Boolean
'local variable(s) to hold property value(s)
Private mvarHandle As Long 'local copy
Private mvarFileSize As Long 'local copy
Private mvarCurrentFileMode As IOMode 'local copy
Private mvarCursorPosition As Long 'local copy
Private mvarCurrentShareMode As ShareMode 'local copy
Public Sub ToSkipLines(Optional Number As Long = 1)
ToReadLines (Number)
End Sub
Public Sub ToSkip(Optional Lenght As Long = 1)
If mvarCurrentFileMode <> ForReading Or mvarCurrentFileMode = 0 Then
RaiseEvent Error(BadFileMode)
Exit Sub
End If
If Lenght = 0 Then Exit Sub
If mvarCursorPosition + Lenght > mvarFileSize Then
RaiseEvent Error(EndOfFileReached)
Exit Sub
End If
Dim ret As Long
ret = SetFilePointer(mvarHandle, mvarCursorPosition + Lenght, 0, 0)
mvarCursorPosition = mvarCursorPosition + Lenght
End Sub
Public Sub ToWriteBlankLines(Optional Number As Long = 1)
If mvarCurrentFileMode = ForAppending Or ForWritting And mvarCurrentFileMode <> 0 Then
Else
RaiseEvent Error(BadFileMode)
Exit Sub
End If
If Number < 1 Then
RaiseEvent Error(InvalidNumber)
Exit Sub
End If
For i = 1 To Number
ToWrite Chr(13) + Chr(10)
Next
End Sub
Public Sub ToWrite(Data As String)
If mvarCurrentFileMode = ForAppending Or ForWritting And mvarCurrentFileMode <> 0 Then
Else
RaiseEvent Error(BadFileMode)
Exit Sub
End If
'Debug.Print "Écriture"
Dim Bufstr As String, buflen As Long, ret As Long
Bufstr = Data
buflen = Len(Bufstr)
WriteFile mvarHandle, ByVal Bufstr, buflen, ret, ByVal 0&
SetEndOfFile mvarHandle
End Sub
Public Sub ToWriteLine(Data As String)
ToWrite (Data & Chr(13) & Chr(10))
End Sub
Public Function ToReadLines(Optional Number As Long = 1) As String
If mvarCurrentFileMode <> ForReading Then
MsgBox mvarCurrentFileMode
RaiseEvent Error(BadFileMode)
Exit Function
End If
If Number < 1 Then
RaiseEvent Error(InvalidNumber)
Exit Function
End If
Dim total As String, car As String, etape As Boolean
For i = 1 To Number
Do
car = 0
car = ToRead(1)
If etape = False Then
If car = Chr(13) Then etape = True: total = total & Chr(13) Else: total = total & car
Else
    If car = Chr(10) Then
    total = total & Chr(10)
    Exit Do
    Else
    total = total & car
    End If
End If
If Me.AtEndOfStream = True Then GoTo toend
Loop
Next
toend:
ToReadLines = total
End Function
Public Function ToRead(Optional Lenght As Long = 0) As String
If mvarCurrentFileMode <> ForReading Then
MsgBox mvarCurrentFileMode
RaiseEvent Error(BadFileMode)
Exit Function
End If
Dim dat As String, ret As Long
If Lenght < 1 Then
Lenght = mvarFileSize - mvarCursorPosition
Else
If mvarCursorPosition + Lenght > mvarFileSize Then
RaiseEvent Error(EndOfFileReached)
Exit Function
End If
End If
dat = String(Lenght, 0)
ret = ReadFile(mvarHandle, ByVal dat, Lenght, ret, ByVal CLng(0))
mvarCursorPosition = mvarCursorPosition + Lenght
ToRead = dat
End Function
Public Sub CreateFile(File As String, Optional OverWrite As Boolean = True)
On Error GoTo erreurCR
If mvarHandle <> Empty Then Exit Sub
If FileExists(File) = 1 Then
If OverWrite = False Then
RaiseEvent Error(FileAleardyExist)
Else
Kill File
End If
End If
OpenFile File, ForWritting, True
Exit Sub
erreurCR:
RaiseEvent Error(Unknown)
End Sub
Public Sub OpenFile(File As String, Optional Mode As IOMode = &H80000000, Optional Create As Boolean = True, Optional StartPosition As FilePosition = -2)
Dim dispo As FileDisposition, Beg As Long, sh As ShareMode
sh = FILE_SHARE_READ Or FILE_SHARE_WRITE
If FileExists(File) = 0 Then
If Create = True Then
dispo = CREATE_NEW
Else
RaiseEvent Error(CannotCreateFile)
End If
Else
dispo = OPEN_EXISTING
End If
If Mode = ForAppending Or Mode = ForReading Or Mode = ForWritting Then
mvarHandle = CreateFile_(File, Mode, sh, ByVal 0&, dispo, 0, 0)
If mvarHandle = -1 Then
RaiseEvent Error(CannotOpenFile)
mvarHandle = Empty
Exit Sub
End If
mvarFileSize = GetFileSize(mvarHandle, 0)
mvarCurrentFileMode = Mode
If Mode = ForAppending Then
    If StartPosition = The_Begin Or StartPosition = The_End Then
        If StartPosition = The_Begin Then Beg = 0 Else: Beg = mvarFileSize
    Else
    If StartPosition < 0 Then
    RaiseEvent Error(InvalidStartPosition)
    Exit Sub
    End If
    Beg = StartPosition
    End If
SetFilePointer mvarHandle, Beg, 0, FILE_BEGIN
End If
Else
RaiseEvent Error(UnknownMethod)
End If
End Sub
Public Sub CloseFile()
CloseHandle mvarHandle
mvarsharemode = Empty
mvarHandle = Empty
mvarAtEndOfStream = False
mvarcurrentposition = Empty
mvarCurrentFileMode = Empty
mvarFileSize = Empty
End Sub
Private Sub Clean()
mbus = False
CloseFile
End Sub
Function ReadWizzard(PakSize As Long, Optional Begin As Long, Optional TheEnd As Long = 0)
If mvarPosition <> 0 Or mvarCurrentFileMode <> ForReading Then
RaiseEvent Error(BadFileMode)
Exit Function
End If
Dim buf As String, reste As Long
ca = False
If mbus = True Then ReadWizzard = False: Clean: Exit Function Else: ReadWizzard = True
rendu = 0
total = 0
reste = mvarFileSize
If Begin <> 0 Then
If TheEnd > reste Or Begin < 1 Or TheEnd < Begin Or Begin > TheEnd Then: ReadWizzard = False: Clean: Exit Function
Else
TheEnd = reste
End If
rendu = Begin
total = TheEnd - Begin
mbus = True
ToSkip (Begin)
Do Until rendu = TheEnd Or (rendu + PakSize) > TheEnd Or ca = True
buf = ToRead(PakSize)
rendu = rendu + PakSize
RaiseEvent ReadWizzardData(buf, Perc)
DoEvents
Loop
If ca = True Then Clean: Exit Function
If rendu <> TheEnd Then buf = ToRead(TheEnd - rendu): rendu = (TheEnd - rendu): RaiseEvent ReadWizzardData(buf, Perc)
Clean
RaiseEvent ReadWizzardFinish
End Function
Public Sub StopReadWizzard()
ca = True
End Sub
Public Property Get CurrentShareMode() As ShareMode
    Set CurrentShareMode = mvarCurrentShareMode
End Property
Public Property Get AtEndOfStream() As Boolean
 If mvarCursorPosition = mvarFileSize Then AtEndOfStream = True Else: AtEndOfStream = False
End Property
Public Property Get CursorPosition() As Long
    CursorPosition = mvarCursorPosition
End Property
Public Property Get CurrentFileMode() As IOMode
    Set CurrentFileMode = mvarCurrentFileMode
End Property
Public Property Get FileSize() As Long
FileSize = mvarFileSize
End Property
Public Property Get Handle() As Long
    Handle = mvarHandle
End Property
Public Property Get WizzardBusy() As Boolean
    WizzardBusy = mbus
End Property
Private Property Get Perc() As Long
    Perc = Round(((rendu / total) * 100), 0)
  End Property
Private Sub UserControl_Initialize()
UserControl.Width = 2535
UserControl.Height = 780
End Sub
Private Sub UserControl_Resize()
UserControl.Width = 2535
UserControl.Height = 780
End Sub
Private Sub UserControl_Terminate()
'Debug.Print "Fermeture de " & mvarHandle
CloseHandle mvarHandle
End Sub

Conclusion :


DITES MOI SI VOUS TROUVEZ LE MOINDRE BUG PLZ.

Codes Sources

A voir également

Ajouter un commentaire

Commentaires

Commenter la réponse de BruNews

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.