bonsoir:

bon je cherche à savoir comment envoyer un fichier via le RS232, j'ai deja cherché en net (voyant que je suis débutante en vb) et j'ai trouver ce code qui permet d'envoyer une image précise:


Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
Dim pic As String
Private Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
 
 
Private Sub File1_Click()
pic = File1.FileName
Image1.Picture = LoadPicture(pic)
 
End Sub
 
Private Sub Form_Load()
MSComm1.CommPort = 1
MSComm1.Settings = "56000,n,8,1"
MSComm1.PortOpen = True
pic = App.Path & "\sample.bmp"
End Sub
 
Private Sub Command1_Click()
 
Call Compression.CompressFile(pic, App.Path & "\shoot.jp_", 9)
Dim Datas As String
Datas = ""
Open App.Path & "\shoot.jp_" For Binary Access Read As #1
    Datas = Input(LOF(1), #1)
Close
 
'envoi le fichier compressé
lng = Len(Datas)
 
If lng > 499 Then    'si la longueur est suppérieur à 499 octets, on divise par 500
   For rt = 1 To lng Step 500
       ProgressBar1.Value = (Int((rt * 100) / lng))
       DoEvents
       b$ = (Mid(Datas, rt, 500))
       MSComm1.Output = b$
   Next rt
   reste = (lng - ((Int(lng / 500) * 500)))
   b$ = (Right(Datas, reste))
Else      'sinon on l'envoi comme ça
   b$ = (Datas)
End If
 
MSComm1.Output = b$
 
qsd = Timer    ' Une petite pause
Do
DoEvents
Loop Until Timer > qsd + 0.5
 
MSComm1.Output = "Fin"  ' on envoi "Fin"
ProgressBar1.Value = 0
End Sub
avec aussi en module :
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
Option Explicit
 
'Déclaration
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long)
Private Declare Function compress Lib "zlib.dll" (dest As Any, destLen As Any, src As Any, ByVal srcLen As Long) As Long
Private Declare Function compress2 Lib "zlib.dll" (dest As Any, destLen As Any, src As Any, ByVal srcLen As Long, ByVal level As Long) As Long
Private Declare Function uncompress Lib "zlib.dll" (dest As Any, destLen As Any, src As Any, ByVal srcLen As Long) As Long
 
'Variable
Dim lngCompressedSize As Long
Dim lngDecompressedSize As Long
 
Enum CZErrors 'Constante pour la compression/décompression
    Z_OK = 0
    Z_STREAM_END = 1
    Z_NEED_DICT = 2
    Z_ERRNO = -1
    Z_STREAM_ERROR = -2
    Z_DATA_ERROR = -3
    Z_MEM_ERROR = -4
    Z_BUF_ERROR = -5
    Z_VERSION_ERROR = -6
End Enum
 
Enum CompressionLevels 'Constante pour la compression/décompression
    Z_NO_COMPRESSION = 0
    Z_BEST_SPEED = 1
    'Les Levels 2-8 existe aussi
    Z_BEST_COMPRESSION = 9
    Z_DEFAULT_COMPRESSION = -1
End Enum
 
Public Property Get ValueCompressedSize() As Long
    'Taille de l'objet après compression
    ValueCompressedSize = lngCompressedSize
End Property
 
Private Property Let ValueCompressedSize(ByVal New_ValueCompressedSize As Long)
    lngCompressedSize = New_ValueCompressedSize
End Property
 
Public Function CompressByteArray(TheData() As Byte, CompressionLevel As Integer) As Long
    'compresse a byte array
    Dim lngResult As Long
    Dim lngBufferSize As Long
    Dim arrByteArray() As Byte
 
    lngDecompressedSize = UBound(TheData) + 1
 
    'Allocate memory for byte array
    lngBufferSize = UBound(TheData) + 1
    lngBufferSize = lngBufferSize + (lngBufferSize * 0.01) + 12
    ReDim arrByteArray(lngBufferSize)
 
    'Compress byte array (data)
    lngResult = compress2(arrByteArray(0), lngBufferSize, TheData(0), UBound(TheData) + 1, CompressionLevel)
 
    'Truncate to compressed size
    ReDim Preserve TheData(lngBufferSize - 1)
    CopyMemory TheData(0), arrByteArray(0), lngBufferSize
 
    'Set property
    lngCompressedSize = UBound(TheData) + 1
 
    'return error code (if any)
    CompressByteArray = lngResult
 
End Function
 
Public Function CompressString(Text As String, CompressionLevel As Integer) As Long
    'compress a string
    Dim lngOrgSize As Long
    Dim lngReturnValue As Long
    Dim lngCmpSize As Long
    Dim strTBuff As String
 
    ValueDecompressedSize = Len(Text)
 
    'Allocate string space for the buffers
    lngOrgSize = Len(Text)
    strTBuff = String(lngOrgSize + (lngOrgSize * 0.01) + 12, 0)
    lngCmpSize = Len(strTBuff)
 
    'Compress string (temporary string buffer) data
    lngReturnValue = compress2(ByVal strTBuff, lngCmpSize, ByVal Text, Len(Text), CompressionLevel)
 
    'Crop the string and set it to the actual string.
    Text = Left$(strTBuff, lngCmpSize)
 
    'Set compressed size of string.
    ValueCompressedSize = lngCmpSize
 
    'Cleanup
    strTBuff = ""
 
    'return error code (if any)
    CompressString = lngReturnValue
 
End Function
 
Public Function CompressFile(FilePathIn As String, FilePathOut As String, CompressionLevel As Integer) As Long
 
    'compress a file
    Dim intNextFreeFile As Integer
    Dim TheBytes() As Byte
    Dim lngResult As Long
    Dim lngFileLen As Long
 
    lngFileLen = FileLen(FilePathIn)
 
    'allocate byte array
    ReDim TheBytes(lngFileLen - 1)
 
    'read byte array from file
    Close #10
    intNextFreeFile = FreeFile '10 'FreeFile
    Open FilePathIn For Binary Access Read As #intNextFreeFile
        Get #intNextFreeFile, , TheBytes()
    Close #intNextFreeFile
 
    'compress byte array
    lngResult = CompressByteArray(TheBytes(), CompressionLevel)
 
    'kill any file in place
    On Error Resume Next
    Kill FilePathOut
    On Error GoTo 0
 
    'Write it out
    intNextFreeFile = FreeFile
    Open FilePathOut For Binary Access Write As #intNextFreeFile
        Put #intNextFreeFile, , lngFileLen 'must store the length of the original file
        Put #intNextFreeFile, , TheBytes()
    Close #intNextFreeFile
 
    Erase TheBytes
    CompressFile = lngResult
 
End Function


j'ai essayé de rendre cet envoie valable pour tous les fichiers mais j'ai pas reussi de le faire .
bon svp si vous avez une idée , ne tardez pas de m'aider