谁能帮我把一段VB代码转为DELPHI? ( 积分: 100 )

A

aloze

Unregistered / Unconfirmed
GUEST, unregistred user!
代码: 
Public Sub TxtToBin(strTxtFile As String, strBFile As String)
Dim TxtFileName As String
Dim BFileName As String
Dim BFileNum As Integer
Dim TxtFileNum As Integer
Dim Bytes_Num As Double
Dim Bytes() As Byte
Dim FileContent As String
Dim ch As Integer
Dim i As Double
Dim j As Integer
Dim n As Integer
Dim recCount As Double
On Error GoTo ErrorMsg
    
    BFileName = strBFile
    DoEvents
    BFileNum = FreeFile
    Open BFileName For Output As BFileNum
    TxtFileName = strTxtFile
    TxtFileNum = FreeFile
    Open TxtFileName For Binary As #TxtFileNum
    Bytes_Num = LOF(TxtFileNum)
    ReDim Bytes(1 To Bytes_Num)
    Get #TxtFileNum, , Bytes
    Close TxtFileNum
    n = 0
    i = 1
    '设置进度条显示相关变量
    recCount = Bytes_Num
    If recCount = 0 Then recCount = 1
    Do While i <= Bytes_Num
        '生成行首字串
        FileContent = "00" & Format$(Hex$(&H20000 + i / 16), "@@@@@") & "010"
        '生成一整行
        For j = 0 To 15
            '补足最后一行
            If i + j > Bytes_Num Then
                FileContent = FileContent & "00"
            Else
                '从以二进制读取的TXT文件中取元素
                ch = Bytes(i + j)
                '判断元素是否为空格，&H20为十六进制的空格
                If ch = &H20 Then
                    n = n + 1
                ElseIf (n < 4 And ch <> &H20) Then
                    n = 0
                End If
                '将读取元素转换成十六进制，并加入字串，并保证加入为两位十六进制数
                If (ch < 16 And ch > 0) Then
                    FileContent = FileContent & 0 & Format$(Hex$(ch), "@")
                Else
                    FileContent = FileContent & Format$(Hex$(ch), "@@")
                End If
            End If
        Next j
        '写到文件
        Print #BFileNum, FileContent
        i = i + 16
        '设置进度条显示
        Main.PBarMain.Value = Round(20 * i / recCount) + 45
    Loop
    Close BFileNum
   Exit Sub
End Sub

谁能帮我把上面这段VB代码转为DELPHI?谢谢了
 
代码: 
Public Sub TxtToBin(strTxtFile As String, strBFile As String)
Dim TxtFileName As String
Dim BFileName As String
Dim BFileNum As Integer
Dim TxtFileNum As Integer
Dim Bytes_Num As Double
Dim Bytes() As Byte
Dim FileContent As String
Dim ch As Integer
Dim i As Double
Dim j As Integer
Dim n As Integer
Dim recCount As Double
On Error GoTo ErrorMsg
    
    BFileName = strBFile
    DoEvents
    BFileNum = FreeFile
    Open BFileName For Output As BFileNum
    TxtFileName = strTxtFile
    TxtFileNum = FreeFile
    Open TxtFileName For Binary As #TxtFileNum
    Bytes_Num = LOF(TxtFileNum)
    ReDim Bytes(1 To Bytes_Num)
    Get #TxtFileNum, , Bytes
    Close TxtFileNum
    n = 0
    i = 1
    '设置进度条显示相关变量
    recCount = Bytes_Num
    If recCount = 0 Then recCount = 1
    Do While i <= Bytes_Num
        '生成行首字串
        FileContent = "00" & Format$(Hex$(&H20000 + i / 16), "@@@@@") & "010"
        '生成一整行
        For j = 0 To 15
            '补足最后一行
            If i + j > Bytes_Num Then
                FileContent = FileContent & "00"
            Else
                '从以二进制读取的TXT文件中取元素
                ch = Bytes(i + j)
                '判断元素是否为空格，&H20为十六进制的空格
                If ch = &H20 Then
                    n = n + 1
                ElseIf (n < 4 And ch <> &H20) Then
                    n = 0
                End If
                '将读取元素转换成十六进制，并加入字串，并保证加入为两位十六进制数
                If (ch < 16 And ch > 0) Then
                    FileContent = FileContent & 0 & Format$(Hex$(ch), "@")
                Else
                    FileContent = FileContent & Format$(Hex$(ch), "@@")
                End If
            End If
        Next j
        '写到文件
        Print #BFileNum, FileContent
        i = i + 16
        '设置进度条显示
        Main.PBarMain.Value = Round(20 * i / recCount) + 45
    Loop
    Close BFileNum
   Exit Sub
End Sub

谁能帮我把上面这段VB代码转为DELPHI?谢谢了
 
鉴于你的程序的目的，是学 Delphi？还是要实现相应的功能？
我只能简单批注每行可能转换的Delphi 语句
但是整个程序的实现因为两者结构的不同，不可能一一转换，
我想问：要 TxtToBin 的目的是什么？
下面是我用 Delphi 来写的 TxtToBin 的程序。

代码: 
Public Sub TxtToBin(strTxtFile as string, strBFile as string)
//    procedure TxtToBin(strTxtFile, strBFile: String);
Dim TxtFileName as string
Dim BFileName as string
Dim BFileNum as Integer
Dim TxtFileNum as Integer
Dim Bytes_Num as Double
Dim Bytes() as Byte
Dim FileContent as string
Dim ch as Integer
Dim i as Double
Dim j as Integer
Dim n as Integer
Dim recCount as Double
//var
//  TxtFileName : String;
//  BFileName : String;
//  BFileNum : Integer;
//  TxtFileNum : Integer;
//  Bytes_Num : real;
//  Bytes() : Byte;
//  FileContent : String;
//  ch : Integer;
//  i : real;
//  j : Integer;
//  n : Integer;
//  recCount : real;

on Error goto ErrorMsg
// Application.OnException = ErrorMsg;

BFileName = strBFile
//BFileName := strBFile
  DoEvents
//没有这样的调用语句
  BFileNum = FreeFile
//BFileNum := FreeFile
  Open BFileName for Output as BFileNum
//AssignFile(F1, BFileName);
//Rewrite(F1);
  TxtFileName = strTxtFile
  TxtFileNum = FreeFile
  Open TxtFileName for Binary as # TxtFileNum
//AssignFile(F2, TxtFileName);
//Rewrite(F2, 1);
  Bytes_Num = LOF(TxtFileNum)
//  Bytes_Num := F2.FileSize;
  ReDim Bytes(1 to Bytes_Num)
//var Bytes: Array[1..bytes_num] of byte;
  Get # TxtFileNum, , Bytes
//Readln(F2, Bytes[1],....);不怎么清楚
  Close TxtFileNum
//  CloseFile(F2);
  n = 0  //n := 0;
  i = 1
  '设置进度条显示相关变量
  recCount = Bytes_Num
  if recCount = 0 then recCount = 1
  do while i <= Bytes_Num
    '生成行首字串
    FileContent = "00" & Format$(Hex$(&H20000 + i / 16), "@@@@@")& "010"
    '生成一整行
//
//
    for j = 0 to 15

    '补足最后一行
    if i + j > Bytes_Num then
    FileContent = FileContent & "00"
  else
    '从以二进制读取的TXT文件中取元素
      ch = Bytes(i + j)
      '判断元素是否为空格，&H20为十六进制的空格
      if ch = &H20 then
//      if ch = &H20 then
      n = n + 1
// N := N + 1
        ElseIf(n < 4 and ch <> &H20) then
//        Else If(n < 4 and ch <> &H20) then
        n = 0
//N := 0;
end if
//不需要
'将读取元素转换成十六进制，并加入字串，并保证加入为两位十六进制数
  if (ch < 16 and ch > 0) then
//  if (ch < 16 and ch > 0) then
  FileContent = FileContent & 0 & Format$(Hex$(ch), "@")
//FileContent = FileContent + '0' + StrToHex(ch)
else
  FileContent = FileContent & Format$(Hex$(ch), "@@")
//FileContent = FileContent + StrToHex(ch)
end if
end if
Next j
  '写到文件
  Print #BFileNum, FileContent
//  Writeln(F2, BFileNum);
  i = i + 16
//i := i + 16;
  '设置进度条显示
  Main.PBarMain.Value = Round(20 * i / recCount) + 45
//  Main.PBarMain.Value := Round(20 * i / recCount) + 45'
//end;
  Loop
  Close BFileNum
  Exit Sub
//End;
end Sub[/ code]
 
procedure Txt2Bin(FName1, FName2: string);
var
F1: file;
F2: TextFile;
Buf: array[1..4096] of Byte;
I, N: integer;
S: string;
begin
AssignFile(F1, FName1);
Reset(F1, 1);
AssignFile(F2, FName2);
Rewrite(F2);
repeat
BlockRead(F1, Buf[1], 4096, N);
S := '';
for i := 1 to n do begin
S := S + Format('#%s ', [IntToHex(Buf, 2)]);
end;
Write(F2, S);
until N < 4096;
CloseFile(F2);
CloseFile(F1);
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
Txt2Bin('D:/符号文件.txt', 'D:/TEST.TXT');
end;
 
您必须登录或注册才可回复。

Similar threads

I
网卡的物理地址和IP地址的相互查询
回复
0
查看
809
import
I
I
FTP 使用 WININET
回复
0
查看
672
import
I
I
一个键盘Hook控件
回复
0
查看
615
import
I
Z
(异或运算)哪位帮忙把java代码转成delphi的(100)
回复
4
查看
604
zhai2008
Z
Y
VB代码转为Delphi..在线等.搞定就给分..(200)
回复
2
查看
364
yeszhang
Y
顶部