问个关于二进制文件读写的问题

Question

程序要先创建一个二进制文件a.abc,长度为100字节，内容全为0，程序有两个个文本框，内容为数字“322”和“332”，要求：把文本框中的内容写入一个二进制文件a.abc中，位置分别是在文件的第50个字节开始和第60个字节开始。请给出创建文件和写入内容的示例代码。

Answer 1

unit main;interfaceuses
  Windows, Messages, SysUtils, Classes, Controls, Forms, Dialogs,
  Menus, StdCtrls, ComCtrls;type
    Tform1 = class(TForm)
    MainMenu: TMainMenu;
    MenuFile: TMenuItem;
    MenuOpen: TMenuItem;
    MenuSaveAs: TMenuItem;
    N1: TMenuItem;
    MenuExit: TMenuItem;
    OpenDlg: TOpenDialog;
    SaveDlg: TSaveDialog;
    Richtext: TRichEdit;
    StatusBar: TStatusBar;
    MenuPopup: TPopupMenu;
    MenuSelectAll: TMenuItem;
    MenuCopy: TMenuItem;
    menuhelp: TMenuItem;
    A1: TMenuItem;
    procedure FormCreate(Sender: TObject);
    procedure MenuOpenClick(Sender: TObject);
    procedure MenuSaveAsClick(Sender: TObject);
    procedure MenuExitClick(Sender: TObject);
    procedure MenuPopupPopup(Sender: TObject);
    procedure MenuSelectAllClick(Sender: TObject);
    procedure MenuCopyClick(Sender: TObject);
  private
    procedure Progress(Address:LongInt);
  end;var
  form1: Tform1;implementation{$R *.DFM}type
  THexConversion = class(TConversion)
  public
    function ConvertReadStream(Stream:TStream; Buffer:PChar;
                               BufSize:integer): integer; override;
  end;
// This implements a callback procedure used by TRichEdit when loading
// a file.  Gets called repeatedly until stream is empty.
//
function THexConversion.ConvertReadStream(Stream:TStream; Buffer:PChar;
                                          BufSize:integer): integer;
var s:string;
    buf:array[1..16] of char;
    i,n:integer;
begin
  Result := 0;
  if BufSize <= 82 then Exit;
  s := Format(';%.5x  ',[Stream.Position]);
  n := Stream.Read(buf,16);
  if n = 0 then Exit;
  for i := 1 to n do
    begin
      AppendStr(s,IntToHex(ord(buf[i]),2)+' ');
      if i mod 4 = 0 then AppendStr(s,' ');
    end;
  AppendStr(s,StringOfChar(' ',62-length(s)));
  for i := 1 to n do
    begin
      if (buf[i] < #32) or (buf[i] > #126) then
        buf[i] := '.';
      AppendStr(s,buf[i]);
    end;
  AppendStr(s,#13#10);
  StrPCopy(Buffer,s);
  Result := length(s);
  if Stream.Position and $FFF = 0 then form1.Progress(Stream.Position);
end;procedure Tform1.Progress(Address:LongInt);
begin
  StatusBar.SimpleText := 'Converting...  $'+IntToHex(Address,5);
  StatusBar.Update;
end;procedure Tform1.FormCreate(Sender: TObject);
begin
  Richtext.RegisterConversionFormat('bin',THexConversion);
  Richtext.RegisterConversionFormat('obj',THexConversion);
  Richtext.RegisterConversionFormat('exe',THexConversion);
end;procedure Tform1.MenuOpenClick(Sender: TObject);
var fname:string;
begin
 if OpenDlg.Execute then
   begin
     try
       Screen.Cursor := crHourglass;
       fname := ExtractFileName(OpenDlg.Filename);
       StatusBar.SimpleText := 'Converting...';
       Richtext.Lines.Clear;
       Application.ProcessMessages;
       try
         Richtext.Lines.LoadFromFile(OpenDlg.Filename);
         StatusBar.SimpleText := fname;
       except on E:EFOpenError do
         begin
           StatusBar.SimpleText := '';
           MessageDlg(Format('Can''t open file %s.',[fname]),mtError,[mbOk],0);
         end;
       end;
     finally
       Screen.Cursor := crDefault;
     end;
   end;
end;
procedure Tform1.MenuSaveAsClick(Sender: TObject);
begin
  SaveDlg.Filename := ChangeFileExt(OpenDlg.FileName,'.txt');
  if SaveDlg.Execute then
    Richtext.Lines.SaveToFile(SaveDlg.FileName);
end;procedure Tform1.MenuExitClick(Sender: TObject);
begin
  Close;
end;procedure Tform1.MenuPopupPopup(Sender: TObject);
var SelStart,SelEnd:LongInt;
begin
  Richtext.Perform(EM_GETSEL,WPARAM(@SelStart),WPARAM(@SelEnd));
  MenuCopy.Enabled := SelStart <> SelEnd;
end;procedure Tform1.MenuSelectAllClick(Sender: TObject);
begin
  Richtext.Perform(EM_SETSEL,0,-1);
end;procedure Tform1.MenuCopyClick(Sender: TObject);
begin
  Richtext.Perform(WM_COPY,0,0);
end;end.

Answer 2

这个好象不是我要的啊……
要求创建的二进制文件是a.abc，要求写入的内容指定了位置……

Answer 3

这个问题怎么好象我回答过一次呀?function WriteAtFilePos(FileName, Data: string; Offset: Integer): Boolean;
var
  fid: Integer;
begin
  result := false;
  if Length(data)>0 then
  begin
    if fileexists(filename) then fid := fileOpen(fileName, fmOpenWrite)
    else fid := fileCreate(filename);
    if fid < 0 then exit;
    fileseek(fid, 100, 0);
    setendoffile(fid);       // 设置文件长度100
    fileseek(fid, Offset, 0);
    filewrite(fid, Data[1], Length(Data));
    fileclose(fid);
    result := true;
  end;
end;调用:
  WriteAtFilePos('a.abc', '322', 50);
  WriteAtFilePos('a.abc', '332', 60);

Answer 4

看看这个？
Delphi 6灵感设计范例源代码procedure TForm1.Button1Click(Sender: TObject);
const
   delay=500; //设置读取时间间隔
var
   cpuinfo:SYSTEM_INFO;
   PriorityClass:Integer;
   Priority:Integer;
   TimerLo:DWORD;//保存CPU频率值
   TimerHi:DWORD;
begin
   GetSystemInfo(cpuinfo);
   Edit1.Text:=IntToStr(cpuinfo.wProcessorArchitecture);
   Edit2.Text:=IntToStr(cpuinfo.dwProcessorType);
   PriorityClass := GetPriorityClass(GetCurrentProcess);
//保存当前的进程优先级到变量PriorityClass 中
      Priority := GetThreadPriority(GetCurrentThread);
//保存当前的线程优先级到变量Priority 中
      SetPriorityClass(GetCurrentProcess, REALTIME_PRIORITY_CLASS); 
      SetThreadPriority(GetCurrentThread, THREAD_PRIORITY_TIME_CRITICAL);
  Sleep(10); 
asm
    dw 310Fh
    mov TimerLo, eax
    mov TimerHi, edx
end;
  Sleep(delay);
//延时再读取寄存器值
asm
    dw 310Fh
    sub eax, TimerLo
    sbb edx, TimerHi
    mov TimerLo, eax
    mov TimerHi, edx
end;//在调用结束后要恢复现场，就象中断的处理一样：
  SetThreadPriority(GetCurrentThread, Priority);
  SetPriorityClass(GetCurrentProcess, PriorityClass);
//显示频率信息
  Edit3.Text:=FloatToStr(TimerLo/(1000*delay))+'MHz';//时钟频率单位为MHzend;