Documents liés

Zoury

14/06/2004 à 22:20

Salut Nicolas!

Tu veux remplacer les liens par le contenu du fichier correspondant?

--
Cordialement
Yanick Lefebvre - MVP pour Visual Basic
http://faq.vb.free.fr/?rubrique=0 - http://www.mvps.org/vbnet/
http://www.mentalis.org/agnet/apiguide.shtml - http://www.mztools.com/
"FIJEAN Nicolas" a écrit dans le message
de news:1c14b01c4521b$eb75b150$
Bonjour à tous,

J'ai le document suivant :

a1
a2
a3
a4
(...)
a100

a1, a2, ... sont chacun des liens hypertexte pointant sur
un fichier html stoché sur mon disque dur.
a1 pointe sur C:nicolasa1.html, etc, ...
Je souhaiterais remplacer automatiquement mon document par
le document intégrant tous les fichiers html.
Avez-vous une idée?
Merci beaucoup de votre aide.
Très cordialement
Nicolas

FIJEAN Nicolas

15/06/2004 à 08:43

Bonjour,
Merci de ta réponse. C'est précisement ce que je souhaite
faire.
Cordialement

Nicolas

-----Message d'origine-----
Salut Nicolas!

Tu veux remplacer les liens par le contenu du fichier

correspondant?

--
Cordialement
Yanick Lefebvre - MVP pour Visual Basic
http://faq.vb.free.fr/?rubrique=0 -

http://www.mvps.org/vbnet/

http://www.mentalis.org/agnet/apiguide.shtml -

http://www.mztools.com/

"FIJEAN Nicolas" a

écrit dans le message

de news:1c14b01c4521b$eb75b150$
Bonjour à tous,

J'ai le document suivant :

a1
a2
a3
a4
(...)
a100

a1, a2, ... sont chacun des liens hypertexte pointant sur
un fichier html stoché sur mon disque dur.
a1 pointe sur C:nicolasa1.html, etc, ...
Je souhaiterais remplacer automatiquement mon document par
le document intégrant tous les fichiers html.
Avez-vous une idée?
Merci beaucoup de votre aide.
Très cordialement
Nicolas

.

Zoury

15/06/2004 à 22:25

Salut Nicolas! :O)

a4
(...)
a100

Vu la quantité de fichiers à manipuler, j'opterais pour le file mapping, ça
devrait te procurer beaucoup, beaucoup de vitesse...

Ex :
'***
' Module1
' tiré d'un exemple de Tony Proctor
Option Explicit

Private Declare Function CreateFile _
Lib "kernel32" _
Alias "CreateFileA" _
( _
ByVal lpFileName As String, _
ByVal dwDesiredAccess As Long, _
ByVal dwShareMode As Long, _
ByVal lpSecurityAttributes As Long, _
ByVal dwCreationDisposition As Long, _
ByVal dwFlagsAndAttributes As Long, _
ByVal hTemplateFile As Long _
) As Long

Private Declare Function CreateFileMapping _
Lib "kernel32" _
Alias "CreateFileMappingA" _
( _
ByVal hFile As Long, _
ByVal lpFileMappingAttributes As Long, _
ByVal flProtect As Long, _
ByVal dwMaximumSizeHigh As Long, _
ByVal dwMaximumSizeLow As Long, _
ByVal lpName As String _
) As Long

Private Declare Function MapViewOfFile _
Lib "kernel32" _
( _
ByVal hFileMappingObject As Long, _
ByVal dwDesiredAccess As Long, _
ByVal dwFileOffsetHigh As Long, _
ByVal dwFileOffsetLow As Long, _
ByVal dwNumberOfBytesToMap As Long _
) As Long

Private Declare Function UnmapViewOfFile _
Lib "kernel32" _
( _
ByRef lpBaseAddress As Any _
) As Long

Private Declare Function GetFileSize _
Lib "kernel32" _
( _
ByVal hFile As Long, _
ByRef lpFileSizeHigh As Long _
) As Long

Private Declare Function CloseHandle _
Lib "kernel32" _
( _
ByVal hObject As Long _
) As Long

' Returns address of the address of
' the associated SafeArray descriptor
Private Declare Function VarPtrArray _
Lib "msvbvm60.dll" _
Alias "VarPtr" _
( _
ptr() As Any _
) As Long

Private Const PAGE_READONLY As Long = &H2
Private Const FILE_MAP_READ As Long = 4
Private Const INVALID_HANDLE_VALUE As Long = -1
Private Const OPEN_EXISTING As Long = 3
Private Const FILE_ATTRIBUTE_NORMAL As Long = &H80
Private Const GENERIC_READ As Long = &H80000000

Private Sub Main()
Call MergeFiles("c:input_file.txt", "c:output_file.txt")
End Sub

Private Sub MergeFiles(ByRef sInputFile As String, ByRef sOutputFile As
String)

Dim hFileIn As Long
Dim hFileOut As Long
Dim sFilePath As String

Dim hFile As Long
Dim hFileMap As Long
Dim hMap As Long
Dim l1 As Long
Dim l2 As Long
Dim byData() As Byte
Dim oMap As MapBytesClass

' ouvre le fichier en entré
hFileIn = FreeFile
Open sInputFile For Input As #hFileIn

' ouvre le fichier de sortie
hFileOut = FreeFile
Open sOutputFile For Binary As #hFileOut

' on lit chaque ligne du fichier d'entré
Do Until EOF(hFileIn)

' lit le nom fichier à copier
Line Input #hFileIn, sFilePath

' NB: MapBytesClass.Map() requires the array to already be
dimensioned (i.e. to have
' a SafeArray descriptor). We do it dynamically here merely to
prevent the compiler
' optimising subsequent LBound & UBound calls using any compile-time
array size.
ReDim byData(0 To 0) As Byte

' Ouvre le fichier spécifier
hFile = CreateFile(sFilePath, GENERIC_READ, 0, 0, OPEN_EXISTING,
FILE_ATTRIBUTE_NORMAL, 0)
If hFile = INVALID_HANDLE_VALUE Then
Debug.Print "Failed to open file: " & Hex(Err.LastDllError)
Exit Sub
End If

' Créer le mapping du fichier
hFileMap = CreateFileMapping(hFile, 0, PAGE_READONLY, 0, 0,
"SearchMap")
If hFileMap = 0 Then
Debug.Print "CreateFileMapping failed - LastError: " &
Hex(GetLastError())
Exit Sub
End If

' Créer la vu du fichier
hMap = MapViewOfFile(hFileMap, FILE_MAP_READ, 0, 0, 0)
If hMap = 0 Then
Debug.Print "MapViewOfFile failed - LastError: " &
Hex(GetLastError())
Exit Sub
End If

' On connecte notre tableau Byte() au mapping
Set oMap = New MapBytesClass
Call oMap.Map(VarPtrArray(byData), hMap, GetFileSize(hFile, 0&))

' on ajoute un saut de ligne après le premier fichier
If (LOF(hFileOut)) Then Put #hFileOut, , vbNewLine
' on écrit le texte du fichier
Put #hFileOut, , byData

' on libères les ressources utilisées
Set oMap = Nothing
Call UnmapViewOfFile(hMap)
Call CloseHandle(hFileMap)
Call CloseHandle(hFile)

Loop

' on ferme les fichiers
Close #hFileIn
Close #hFileOut

End Sub
'***
'***
' MapBytesClass - Class Module
' Cette classe à été écrite par Tony Proctor
Option Explicit

Private Declare Sub CopyMemory _
Lib "kernel32" _
Alias "RtlMoveMemory" _
( _
ByRef pDst As Any, _
ByRef pSrc As Any, _
ByVal ByteLen As Long)

Private Type SAFEARRAYBOUND
cElements As Long
lLbound As Long
End Type

Private Type SAFEARRAY
cDims As Integer
fFeatures As Integer
cbElements As Long
cLocks As Long
pvData As Long
Bounds(0 To 0) As SAFEARRAYBOUND
End Type

' Keeping this data here assumes the caller won't ReDim the original array
Private tPrevDesc As SAFEARRAY 'Previous SafeArray content
Private lDesc As Long 'SafeArray address

Public Sub Map(ByVal lpDesc As Long, lAddr As Long, lSize As Long)
' Maps a sequence of bytes using the SafeArray descriptor of an existing
byte array.
' lpDesc is the address of the address of the descriptor. NB: the array must
already
' have been dimensioned or there won't be a descriptor associated with it.
Dim tDesc As SAFEARRAY

On Error GoTo ErrorHandler
' Check for any previous, unreleased mapping
If lDesc <> 0 Then
CopyMemory ByVal lDesc, ByVal VarPtr(tDesc), LenB(tDesc)
lDesc = 0
End If

'Debug.Print "Map ("; Hex(lpDesc); ")" 'Address of descriptor
pointer
If lpDesc = 0 Then Exit Sub
CopyMemory lpDesc, ByVal lpDesc, 4
'Debug.Print "Map "; Hex(lpDesc) 'Descriptor pointer
If lpDesc = 0 Then Exit Sub

' Take copy of previous descriptor body
CopyMemory ByVal VarPtr(tPrevDesc), ByVal lpDesc, LenB(tPrevDesc)
lDesc = lpDesc
' Read body of the SafeArray descriptor into local area for modification
CopyMemory ByVal VarPtr(tDesc), ByVal lpDesc, LenB(tDesc)
With tDesc
.cbElements = 1
.pvData = lAddr
.Bounds(0).cElements = lSize
End With
' Now write back the modified content
CopyMemory ByVal lpDesc, ByVal VarPtr(tDesc), LenB(tDesc)
Exit Sub

ErrorHandler:
Debug.Print "Map: " & Err.Description
End Sub

Private Sub Class_Terminate()
' Release the previous mapping, if any
If lDesc <> 0 Then
CopyMemory ByVal lDesc, ByVal VarPtr(tPrevDesc), LenB(tPrevDesc)
lDesc = 0
End If
End Sub
'***

Si tu as besoin de plus de vitesse il serait peut-être possible d'en gagner
en utiliser l'API WriteFile() pour la création du fichier au lieu de
Open/Put/Close...

--
Cordialement
Yanick Lefebvre - MVP pour Visual Basic
http://faq.vb.free.fr/?rubrique=0 - http://www.mvps.org/vbnet/
http://www.mentalis.org/agnet/apiguide.shtml - http://www.mztools.com/

Salut Nicolas! :O)

a4
(...)
a100

Vu la quantité de fichiers à manipuler, j'opterais pour le file mapping, ça
devrait te procurer beaucoup, beaucoup de vitesse...

Ex :
'***
' Module1
' tiré d'un exemple de Tony Proctor
Option Explicit

Private Declare Function CreateFile _
Lib "kernel32" _
Alias "CreateFileA" _
( _
ByVal lpFileName As String, _
ByVal dwDesiredAccess As Long, _
ByVal dwShareMode As Long, _
ByVal lpSecurityAttributes As Long, _
ByVal dwCreationDisposition As Long, _
ByVal dwFlagsAndAttributes As Long, _
ByVal hTemplateFile As Long _
) As Long

Private Declare Function CreateFileMapping _
Lib "kernel32" _
Alias "CreateFileMappingA" _
( _
ByVal hFile As Long, _
ByVal lpFileMappingAttributes As Long, _
ByVal flProtect As Long, _
ByVal dwMaximumSizeHigh As Long, _
ByVal dwMaximumSizeLow As Long, _
ByVal lpName As String _
) As Long

Private Declare Function MapViewOfFile _
Lib "kernel32" _
( _
ByVal hFileMappingObject As Long, _
ByVal dwDesiredAccess As Long, _
ByVal dwFileOffsetHigh As Long, _
ByVal dwFileOffsetLow As Long, _
ByVal dwNumberOfBytesToMap As Long _
) As Long

Private Declare Function UnmapViewOfFile _
Lib "kernel32" _
( _
ByRef lpBaseAddress As Any _
) As Long

Private Declare Function GetFileSize _
Lib "kernel32" _
( _
ByVal hFile As Long, _
ByRef lpFileSizeHigh As Long _
) As Long

Private Declare Function CloseHandle _
Lib "kernel32" _
( _
ByVal hObject As Long _
) As Long

' Returns address of the address of
' the associated SafeArray descriptor
Private Declare Function VarPtrArray _
Lib "msvbvm60.dll" _
Alias "VarPtr" _
( _
ptr() As Any _
) As Long

Private Const PAGE_READONLY As Long = &H2
Private Const FILE_MAP_READ As Long = 4
Private Const INVALID_HANDLE_VALUE As Long = -1
Private Const OPEN_EXISTING As Long = 3
Private Const FILE_ATTRIBUTE_NORMAL As Long = &H80
Private Const GENERIC_READ As Long = &H80000000

Private Sub Main()
Call MergeFiles("c:input_file.txt", "c:output_file.txt")
End Sub

Private Sub MergeFiles(ByRef sInputFile As String, ByRef sOutputFile As
String)

Dim hFileIn As Long
Dim hFileOut As Long
Dim sFilePath As String

Dim hFile As Long
Dim hFileMap As Long
Dim hMap As Long
Dim l1 As Long
Dim l2 As Long
Dim byData() As Byte
Dim oMap As MapBytesClass

' ouvre le fichier en entré
hFileIn = FreeFile
Open sInputFile For Input As #hFileIn

' ouvre le fichier de sortie
hFileOut = FreeFile
Open sOutputFile For Binary As #hFileOut

' on lit chaque ligne du fichier d'entré
Do Until EOF(hFileIn)

' lit le nom fichier à copier
Line Input #hFileIn, sFilePath

' NB: MapBytesClass.Map() requires the array to already be
dimensioned (i.e. to have
' a SafeArray descriptor). We do it dynamically here merely to
prevent the compiler
' optimising subsequent LBound & UBound calls using any compile-time
array size.
ReDim byData(0 To 0) As Byte

' Ouvre le fichier spécifier
hFile = CreateFile(sFilePath, GENERIC_READ, 0, 0, OPEN_EXISTING,
FILE_ATTRIBUTE_NORMAL, 0)
If hFile = INVALID_HANDLE_VALUE Then
Debug.Print "Failed to open file: " & Hex(Err.LastDllError)
Exit Sub
End If

' Créer le mapping du fichier
hFileMap = CreateFileMapping(hFile, 0, PAGE_READONLY, 0, 0,
"SearchMap")
If hFileMap = 0 Then
Debug.Print "CreateFileMapping failed - LastError: " &
Hex(GetLastError())
Exit Sub
End If

' Créer la vu du fichier
hMap = MapViewOfFile(hFileMap, FILE_MAP_READ, 0, 0, 0)
If hMap = 0 Then
Debug.Print "MapViewOfFile failed - LastError: " &
Hex(GetLastError())
Exit Sub
End If

' On connecte notre tableau Byte() au mapping
Set oMap = New MapBytesClass
Call oMap.Map(VarPtrArray(byData), hMap, GetFileSize(hFile, 0&))

' on ajoute un saut de ligne après le premier fichier
If (LOF(hFileOut)) Then Put #hFileOut, , vbNewLine
' on écrit le texte du fichier
Put #hFileOut, , byData

' on libères les ressources utilisées
Set oMap = Nothing
Call UnmapViewOfFile(hMap)
Call CloseHandle(hFileMap)
Call CloseHandle(hFile)

Loop

' on ferme les fichiers
Close #hFileIn
Close #hFileOut

End Sub
'***
'***
' MapBytesClass - Class Module
' Cette classe à été écrite par Tony Proctor
Option Explicit

Private Declare Sub CopyMemory _
Lib "kernel32" _
Alias "RtlMoveMemory" _
( _
ByRef pDst As Any, _
ByRef pSrc As Any, _
ByVal ByteLen As Long)

Private Type SAFEARRAYBOUND
cElements As Long
lLbound As Long
End Type

Private Type SAFEARRAY
cDims As Integer
fFeatures As Integer
cbElements As Long
cLocks As Long
pvData As Long
Bounds(0 To 0) As SAFEARRAYBOUND
End Type

' Keeping this data here assumes the caller won't ReDim the original array
Private tPrevDesc As SAFEARRAY 'Previous SafeArray content
Private lDesc As Long 'SafeArray address

Public Sub Map(ByVal lpDesc As Long, lAddr As Long, lSize As Long)
' Maps a sequence of bytes using the SafeArray descriptor of an existing
byte array.
' lpDesc is the address of the address of the descriptor. NB: the array must
already
' have been dimensioned or there won't be a descriptor associated with it.
Dim tDesc As SAFEARRAY

On Error GoTo ErrorHandler
' Check for any previous, unreleased mapping
If lDesc <> 0 Then
CopyMemory ByVal lDesc, ByVal VarPtr(tDesc), LenB(tDesc)
lDesc = 0
End If

'Debug.Print "Map ("; Hex(lpDesc); ")" 'Address of descriptor
pointer
If lpDesc = 0 Then Exit Sub
CopyMemory lpDesc, ByVal lpDesc, 4
'Debug.Print "Map "; Hex(lpDesc) 'Descriptor pointer
If lpDesc = 0 Then Exit Sub

' Take copy of previous descriptor body
CopyMemory ByVal VarPtr(tPrevDesc), ByVal lpDesc, LenB(tPrevDesc)
lDesc = lpDesc
' Read body of the SafeArray descriptor into local area for modification
CopyMemory ByVal VarPtr(tDesc), ByVal lpDesc, LenB(tDesc)
With tDesc
.cbElements = 1
.pvData = lAddr
.Bounds(0).cElements = lSize
End With
' Now write back the modified content
CopyMemory ByVal lpDesc, ByVal VarPtr(tDesc), LenB(tDesc)
Exit Sub

ErrorHandler:
Debug.Print "Map: " & Err.Description
End Sub

Private Sub Class_Terminate()
' Release the previous mapping, if any
If lDesc <> 0 Then
CopyMemory ByVal lDesc, ByVal VarPtr(tPrevDesc), LenB(tPrevDesc)
lDesc = 0
End If
End Sub
'***

Si tu as besoin de plus de vitesse il serait peut-être possible d'en gagner
en utiliser l'API WriteFile() pour la création du fichier au lieu de
Open/Put/Close...

--
Cordialement
Yanick Lefebvre - MVP pour Visual Basic
http://faq.vb.free.fr/?rubrique=0 - http://www.mvps.org/vbnet/
http://www.mentalis.org/agnet/apiguide.shtml - http://www.mztools.com/

Vous avez filtré cet utilisateur ! Consultez son message

Salut Nicolas! :O)

a4
(...)
a100

Vu la quantité de fichiers à manipuler, j'opterais pour le file mapping, ça
devrait te procurer beaucoup, beaucoup de vitesse...

Ex :
'***
' Module1
' tiré d'un exemple de Tony Proctor
Option Explicit

Private Declare Function CreateFile _
Lib "kernel32" _
Alias "CreateFileA" _
( _
ByVal lpFileName As String, _
ByVal dwDesiredAccess As Long, _
ByVal dwShareMode As Long, _
ByVal lpSecurityAttributes As Long, _
ByVal dwCreationDisposition As Long, _
ByVal dwFlagsAndAttributes As Long, _
ByVal hTemplateFile As Long _
) As Long

Private Declare Function CreateFileMapping _
Lib "kernel32" _
Alias "CreateFileMappingA" _
( _
ByVal hFile As Long, _
ByVal lpFileMappingAttributes As Long, _
ByVal flProtect As Long, _
ByVal dwMaximumSizeHigh As Long, _
ByVal dwMaximumSizeLow As Long, _
ByVal lpName As String _
) As Long

Private Declare Function MapViewOfFile _
Lib "kernel32" _
( _
ByVal hFileMappingObject As Long, _
ByVal dwDesiredAccess As Long, _
ByVal dwFileOffsetHigh As Long, _
ByVal dwFileOffsetLow As Long, _
ByVal dwNumberOfBytesToMap As Long _
) As Long

Private Declare Function UnmapViewOfFile _
Lib "kernel32" _
( _
ByRef lpBaseAddress As Any _
) As Long

Private Declare Function GetFileSize _
Lib "kernel32" _
( _
ByVal hFile As Long, _
ByRef lpFileSizeHigh As Long _
) As Long

Private Declare Function CloseHandle _
Lib "kernel32" _
( _
ByVal hObject As Long _
) As Long

' Returns address of the address of
' the associated SafeArray descriptor
Private Declare Function VarPtrArray _
Lib "msvbvm60.dll" _
Alias "VarPtr" _
( _
ptr() As Any _
) As Long

Private Const PAGE_READONLY As Long = &H2
Private Const FILE_MAP_READ As Long = 4
Private Const INVALID_HANDLE_VALUE As Long = -1
Private Const OPEN_EXISTING As Long = 3
Private Const FILE_ATTRIBUTE_NORMAL As Long = &H80
Private Const GENERIC_READ As Long = &H80000000

Private Sub Main()
Call MergeFiles("c:input_file.txt", "c:output_file.txt")
End Sub

Private Sub MergeFiles(ByRef sInputFile As String, ByRef sOutputFile As
String)

Dim hFileIn As Long
Dim hFileOut As Long
Dim sFilePath As String

Dim hFile As Long
Dim hFileMap As Long
Dim hMap As Long
Dim l1 As Long
Dim l2 As Long
Dim byData() As Byte
Dim oMap As MapBytesClass

' ouvre le fichier en entré
hFileIn = FreeFile
Open sInputFile For Input As #hFileIn

' ouvre le fichier de sortie
hFileOut = FreeFile
Open sOutputFile For Binary As #hFileOut

' on lit chaque ligne du fichier d'entré
Do Until EOF(hFileIn)

' lit le nom fichier à copier
Line Input #hFileIn, sFilePath

' NB: MapBytesClass.Map() requires the array to already be
dimensioned (i.e. to have
' a SafeArray descriptor). We do it dynamically here merely to
prevent the compiler
' optimising subsequent LBound & UBound calls using any compile-time
array size.
ReDim byData(0 To 0) As Byte

' Ouvre le fichier spécifier
hFile = CreateFile(sFilePath, GENERIC_READ, 0, 0, OPEN_EXISTING,
FILE_ATTRIBUTE_NORMAL, 0)
If hFile = INVALID_HANDLE_VALUE Then
Debug.Print "Failed to open file: " & Hex(Err.LastDllError)
Exit Sub
End If

' Créer le mapping du fichier
hFileMap = CreateFileMapping(hFile, 0, PAGE_READONLY, 0, 0,
"SearchMap")
If hFileMap = 0 Then
Debug.Print "CreateFileMapping failed - LastError: " &
Hex(GetLastError())
Exit Sub
End If

' Créer la vu du fichier
hMap = MapViewOfFile(hFileMap, FILE_MAP_READ, 0, 0, 0)
If hMap = 0 Then
Debug.Print "MapViewOfFile failed - LastError: " &
Hex(GetLastError())
Exit Sub
End If

' On connecte notre tableau Byte() au mapping
Set oMap = New MapBytesClass
Call oMap.Map(VarPtrArray(byData), hMap, GetFileSize(hFile, 0&))

' on ajoute un saut de ligne après le premier fichier
If (LOF(hFileOut)) Then Put #hFileOut, , vbNewLine
' on écrit le texte du fichier
Put #hFileOut, , byData

' on libères les ressources utilisées
Set oMap = Nothing
Call UnmapViewOfFile(hMap)
Call CloseHandle(hFileMap)
Call CloseHandle(hFile)

Loop

' on ferme les fichiers
Close #hFileIn
Close #hFileOut

End Sub
'***
'***
' MapBytesClass - Class Module
' Cette classe à été écrite par Tony Proctor
Option Explicit

Private Declare Sub CopyMemory _
Lib "kernel32" _
Alias "RtlMoveMemory" _
( _
ByRef pDst As Any, _
ByRef pSrc As Any, _
ByVal ByteLen As Long)

Private Type SAFEARRAYBOUND
cElements As Long
lLbound As Long
End Type

Private Type SAFEARRAY
cDims As Integer
fFeatures As Integer
cbElements As Long
cLocks As Long
pvData As Long
Bounds(0 To 0) As SAFEARRAYBOUND
End Type

' Keeping this data here assumes the caller won't ReDim the original array
Private tPrevDesc As SAFEARRAY 'Previous SafeArray content
Private lDesc As Long 'SafeArray address

Public Sub Map(ByVal lpDesc As Long, lAddr As Long, lSize As Long)
' Maps a sequence of bytes using the SafeArray descriptor of an existing
byte array.
' lpDesc is the address of the address of the descriptor. NB: the array must
already
' have been dimensioned or there won't be a descriptor associated with it.
Dim tDesc As SAFEARRAY

On Error GoTo ErrorHandler
' Check for any previous, unreleased mapping
If lDesc <> 0 Then
CopyMemory ByVal lDesc, ByVal VarPtr(tDesc), LenB(tDesc)
lDesc = 0
End If

'Debug.Print "Map ("; Hex(lpDesc); ")" 'Address of descriptor
pointer
If lpDesc = 0 Then Exit Sub
CopyMemory lpDesc, ByVal lpDesc, 4
'Debug.Print "Map "; Hex(lpDesc) 'Descriptor pointer
If lpDesc = 0 Then Exit Sub

' Take copy of previous descriptor body
CopyMemory ByVal VarPtr(tPrevDesc), ByVal lpDesc, LenB(tPrevDesc)
lDesc = lpDesc
' Read body of the SafeArray descriptor into local area for modification
CopyMemory ByVal VarPtr(tDesc), ByVal lpDesc, LenB(tDesc)
With tDesc
.cbElements = 1
.pvData = lAddr
.Bounds(0).cElements = lSize
End With
' Now write back the modified content
CopyMemory ByVal lpDesc, ByVal VarPtr(tDesc), LenB(tDesc)
Exit Sub

ErrorHandler:
Debug.Print "Map: " & Err.Description
End Sub

Private Sub Class_Terminate()
' Release the previous mapping, if any
If lDesc <> 0 Then
CopyMemory ByVal lDesc, ByVal VarPtr(tPrevDesc), LenB(tPrevDesc)
lDesc = 0
End If
End Sub
'***

Si tu as besoin de plus de vitesse il serait peut-être possible d'en gagner
en utiliser l'API WriteFile() pour la création du fichier au lieu de
Open/Put/Close...

--
Cordialement
Yanick Lefebvre - MVP pour Visual Basic
http://faq.vb.free.fr/?rubrique=0 - http://www.mvps.org/vbnet/
http://www.mentalis.org/agnet/apiguide.shtml - http://www.mztools.com/

Zoury

15/06/2004 à 22:34

à noter que dans l'exemple ..

le fichier input_file.txt contient :
c:file1.txt
c:file2.txt
c:file3.txt

le fichier file1.txt contient :
ligne 1
ligne 2
ligne 3
ligne 4
ligne 5

le fichier file2.txt contient :
ligne 6
ligne 7
ligne 8
ligne 9
ligne 10

et le fichier file3.txt contient (roulement de tambour..........) :
ligne 11
ligne 12
ligne 13
ligne 14
ligne 15

après l'exécution du code le fichier output_file.txt contient :
ligne 1
ligne 2
ligne 3
ligne 4
ligne 5
ligne 6
ligne 7
ligne 8
ligne 9
ligne 10
ligne 11
ligne 12
ligne 13
ligne 14
ligne 15

--
Cordialement
Yanick Lefebvre - MVP pour Visual Basic
http://faq.vb.free.fr/?rubrique=0 - http://www.mvps.org/vbnet/
http://www.mentalis.org/agnet/apiguide.shtml - http://www.mztools.com/

Documents liés

4 réponses

Veuillez sélectionner un problème