Public Sub SendFile(fname As String, blocksize As Integer) On Error GoTo exit1: Dim data() As Byte Dim Outfile As TekFile Dim OtprFile_temp As String Outfile.BlockPeredProverkoj = FrmOpt.Slider2.Value If fname = "" Then Exit Sub End If Outfile.Name = Dir(fname) If Outfile.Name = "" Then MsgBox "Файл " + fname + " не найден", vbCritical End If Outfile.Size = FileLen(fname) If Outfile.Size = 0 Then OtprFile_temp = MsgBox("Размер " + fname + " - 0" + vbCrLf + "Продолжить ?", vbCritical + vbYesNo) '!!!!!!!!!!!!!!! If OtprFile_temp = 7 Then Exit Sub End If Outfile.blocksize = blocksize FileSend.Label15.Caption = Outfile.blocksize Do While Otp_Cancel = False OtprFile_temp = "<" + "0;" + Encode64(Outfile.Name) + ";" + CStr(Outfile.Size) + ";" + CStr(Outfile.blocksize) + ">" Label5.Caption = Label5.Caption + Len(OtprFile_temp) MSComm1.Output = OtprFile_temp FileSend.Label20.Caption = Outfile.Name FileSend.Visible = True FileSend.Label8.Caption = Outfile.Size OtprFile_temp = WaitForAnswer(1, "") Outfile.Block = 1 Close #1 If OtprFile_temp <> "" Then Outfile.Block = OtprFile_temp If OtprFile_temp <> 1 Then Sysmes "Продолжение прерванной закачки с " + CStr(Outfile.Block) + "-го блока.", 0, True, True, Text2 Exit Do Else Sysmes "Нет ответа на запрос о принятии файла - повторный запрос.", 0, True, True, Text2 End If Loop 'Call PrnFile_Timer '''''''''''''''''''''''''' Outfile.BlockPeredProverkoj = FrmOpt.Slider2.Value Outfile.DoProverki = Outfile.BlockPeredProverkoj Open fname For Binary As #1 OtpData: Do While Outfile.blocksize < Outfile.Size - Loc(1) If Otp_Cancel = True Then Exit Sub ReDim data(0 To Outfile.blocksize - 1) As Byte OtpData_k: Seek #1, SeekPos(Outfile, Outfile.blocksize) Get #1, , data() FileSend.Label9.Caption = Loc(1) FileSend.Label10.Caption = Outfile.Size - Loc(1) OtprFile_temp = CompressByteArray(data(), 1) '!!!!!!!!!!!!!!!!!!!!!!!!!!! ' If OtprFile_temp <> 0 Then MsgBox OtprFile_temp OtprFile_temp = "<" + CStr(Outfile.Block) + ";" + CStr(Encode64Arr(data())) + ">" OtprFile_temp = Replace(OtprFile_temp, vbCrLf, "") Label5.Caption = Label5.Caption + Len(OtprFile_temp) MSComm1.Output = OtprFile_temp 'crc Outfile.DoProverki = Outfile.DoProverki - 1 Outfile.CalculateBytes = Outfile.CalculateBytes + CalculateBytes(data()) Outfile.Block = Outfile.Block + 1 FileSend.Label17.Caption = Outfile.Block  oEvents ''''''''''''''''''''''' If Outfile.DoProverki = 0 Then MSComm1.Output = "#" DoEvents '''''''''''''''''''''''''''''''''' If Len(WaitForAnswer(1, CStr(Outfile.CalculateBytes))) <> 0 Then SetMeter (Seek(1) - 1) \ (Outfile.Size \ 100), FileSend Outfile.CalculateBytes = 0 Outfile.DoProverki = Outfile.BlockPeredProverkoj 'If SeekPos = OutFile.Size Then MSComm1.Output = "[OUT_OK]" Else FileSend.Label19.Caption = FileSend.Label19.Caption + 1 Outfile.Block = Outfile.Block - Outfile.BlockPeredProverkoj End If End If Loop If Outfile.Size <= Seek(1) - 1 Then FileSend.Visible = False Sysmes "Успешно закачан", 0, True, True, Text2 Close #1 Exit Sub End If If Otp_Cancel = True Then Close #1 Exit Sub End If OtprFile_temp = Outfile.Size - Loc(1) ReDim data(0 To OtprFile_temp - 1) GoTo OtpData_k: Exit Sub If Len(Err.Description) <> 0 Then MsgBox Err.Description, vbCritical, "Ошибка в SendFile" Err.Clear Close #1 End If Exit Sub exit1: Exit Sub End Sub Это кусок из моей терминалки... Старенькой... Щас как-раз новый алгоритьм придумываююю Ты этот почити а если чего не хватит... Ну там какой функции... Пиши на мыло...
Ответить
|