mainform.~pas

这是实现从一个复合码流文件中提取一个节目的程序

unit MainForm;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, ComCtrls, Buttons;

type
  TFormMain = class(TForm)
    Label1: TLabel;
    Image1: TImage;
    PageControl1: TPageControl;
    TabSheet1: TTabSheet;
    Label2: TLabel;
    Edit1: TEdit;
    Bevel1: TBevel;
    OpenDialog1: TOpenDialog;
    Label3: TLabel;
    Edit2: TEdit;
    Button3: TButton;
    Button4: TButton;
    SpeedButton1: TSpeedButton;
    SpeedButton2: TSpeedButton;
    TabSheet2: TTabSheet;
    Memo1: TMemo;
    Label4: TLabel;
    Label5: TLabel;
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure SpeedButton1Click(Sender: TObject);
    procedure SpeedButton2Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
    function ReplaceMediaRes(SrcFileName:String;MediaFileName:String):Boolean;
    function ReplaceMediaRes2(SrcFileName:String;MediaFileName:String):Boolean;
  public
    { Public declarations }
  end;

var
  FormMain: TFormMain;

implementation

{$R *.dfm}

{ TFormMain }

function TFormMain.ReplaceMediaRes(SrcFileName:String;MediaFileName:String):Boolean;
var
  fs:TFileStream;
  buffer:PChar;
  hUpdateRes:THandle;
begin
  result:=false;
  if not FileExists(SrcFileName) then begin
    MessageBox(Handle,pchar(SrcFileName+' not exists.'),pchar(Application.Title),MB_ICONERROR);
    exit;
  end;
  if not (FileExists(MediaFileName)) then begin
    MessageBox(Handle,pchar(MediaFileName+' not exists.'),pchar(Application.Title),MB_ICONERROR);
    exit;
  end;
  fs:=TFileStream.Create(MediaFileName,fmOpenRead or fmShareDenyWrite);
  try
    GetMem(buffer,fs.size);
    try
      fs.ReadBuffer(buffer^,fs.size);
      //begin update resource
      hUpdateRes:=BeginUpdateResource(pchar(SrcFileName),false);
      if(hUpdateRes=0) then begin
        MessageBox(Handle,pchar('Error to begin update resource.'),pchar(Application.Title),MB_ICONERROR);
        exit;
      end;
      //!! the language id can get with GetUserDefaultLangID(), in english system it's 1033.
      //  if there already have a resource with the same name in the player file, the new resource must
      //  be the same language id with the old resource, else the old resource wont be delete,
      //  and the player wont found the new resource. But now ,there is no old resource in the player
      //  so i can write a new reosurce into it with any language id.
      result:=UpdateResource(hUpdateRes,pchar('PLAYER'),pchar('MEDIA'),GetUserDefaultLangID(),buffer,fs.Size);
      if not result then begin
        MessageBox(Handle,pchar('Error ro update resource'),pchar(Application.Title),MB_ICONERROR);
        exit;
      end;
      if not EndUpdateResource(hUpdateRes,false) then begin
        MessageBox(Handle,pchar('Error to end update resource.'),pchar(Application.Title),MB_ICONERROR);
        exit;
      end;
    finally
      FreeMem(buffer);
    end;
  finally
    fs.Free;
  end;
  result:=true;
end;

function TFormMain.ReplaceMediaRes2(SrcFileName:String;MediaFileName:String):Boolean;
const
  SizeOffset=28748;//=0x704cH
  ResOffset=28800;//=0x7080H
  OldResSize=5;//=sizeof('empty')
var
  fsS,fsM:TFileStream;
  bufM,bufTemp:PChar;
  bufMSize,bufTSize:Integer;
begin
  result:=false;
  if not FileExists(SrcFileName) then begin
    MessageBox(Handle,pchar(SrcFileName+' not exists.'),pchar(Application.Title),MB_ICONERROR);
    exit;
  end;
  if not (FileExists(MediaFileName)) then begin
    MessageBox(Handle,pchar(MediaFileName+' not exists.'),pchar(Application.Title),MB_ICONERROR);
    exit;
  end;
  fsS:=TFileStream.Create(SrcFileName,fmOpenReadWrite);
  fsM:=TFileStream.Create(MediaFileName,fmOpenReadWrite);
  try
    bufMSize:=fsM.Size;
    //change the size of resource
    fsS.Seek(SizeOffset,soFromBeginning);
    fsS.WriteBuffer(bufMSize,sizeof(Integer));
    //save the buf following the res to a temp buf
    bufTSize:=fsS.Size-ResOffset-OldResSize;
    GetMem(bufTemp,bufTSize);
    fsS.Seek(ResOffset+OldResSize,soFromBeginning);
    fsS.ReadBuffer(bufTemp^,bufTSize);
    //read media buffer from file
    GetMem(bufM,bufMSize);
    fsM.ReadBuffer(bufM^,bufMSize);
    //write media buffer to src file
    fsS.Seek(ResOffset,soFromBeginning);
    fsS.WriteBuffer(bufM^,bufMSize);
    //write temp buffer to the srcfile
    fsS.WriteBuffer(bufTemp^,bufTSize);
    FreeMem(bufTemp);
    FreeMem(bufM);
  finally
    fsS.Free;
    fsM.Free;
  end;
  result:=true;
end;

procedure TFormMain.Button3Click(Sender: TObject);
var
  SrcFileName:String;
begin
  SrcFileName:=ExtractFilePath(Application.ExeName)+'MiniPlayer.sys';
  if not FileExists(SrcFileName) then begin
    MessageBox(Handle,pchar(SrcFileName+' not exists.'),pchar(Application.Title),MB_ICONERROR);
    exit;
  end;
  if FileExists(Edit2.Text) then begin
    if MessageBox(Handle,pchar(Edit2.Text+' already exists, do you want to replace it?'),pchar(Application.Title),MB_ICONQUESTION+MB_YESNO)=IDNO then
      exit;
  end;
  if not CopyFile(pchar(SrcFileName),pchar(Edit2.Text),false) then begin
    MessageBox(Handle,pchar('Can''t copy file.'),pchar(Application.Title),MB_ICONERROR);
    exit;
  end;
  if ReplaceMediaRes(Edit2.Text,Edit1.Text) then
    MessageBox(Handle,pchar('Create MiniPlayer executable file successful.'),pchar(Application.Title),MB_ICONINFORMATION)
  else
    MessageBox(Handle,pchar('Error when replace media.'),pchar(Application.Title),MB_ICONERROR);
end;

procedure TFormMain.Button4Click(Sender: TObject);
begin
  close;
end;

procedure TFormMain.SpeedButton1Click(Sender: TObject);
begin
  if Edit1.Text=EmptyStr then
    OpenDialog1.InitialDir:=ExtractFilePath(Application.ExeName)
  else
    OpenDialog1.FileName:=Edit1.Text;
  if OpenDialog1.Execute then begin
    Edit1.Text:=OpenDialog1.FileName;
    Edit2.Text:=ChangeFileExt(Edit1.Text,'.exe');
  end;
end;

procedure TFormMain.SpeedButton2Click(Sender: TObject);
begin
  if Edit2.Text=EmptyStr then
    OpenDialog1.InitialDir:=ExtractFilePath(Application.ExeName)
  else
    OpenDialog1.FileName:=Edit2.Text;
  if OpenDialog1.Execute then
    Edit2.Text:=OpenDialog1.FileName;
end;

procedure TFormMain.FormCreate(Sender: TObject);
begin
  if FileExists(ExtractFilePath(Application.ExeName)+'readme.txt') then
    Memo1.Lines.LoadFromFile(ExtractFilePath(Application.ExeName)+'readme.txt');
end;

end.