www.pudn.com > MP4Cam2AVI_SRC_1.2.zip > Buffer.pas

unit Buffer; 
 
interface 
 
uses 
  Windows; 
 
{$UNDEF UNICODE} 
 
type 
  PBuffer = ^TBuffer; 
  TBuffer = array of char; 
 
function DwordToStr(d: integer):string; 
function StrToDword(s: string):integer; 
function HexNum(c: char):byte; 
function DwordReverse(var d: integer):integer; 
procedure HexStringToBuffer(var buf: TBuffer; s: string; StartPos: integer); 
function BufferToDwordRev(var buf: TBuffer; index: integer):integer; 
function BufferToDword(var buf: TBuffer; index: integer):integer; 
function BufferToByte(var buf: TBuffer; index: integer):byte; 
function BufferToString(var buf: TBuffer; index: integer; count: integer):string; 
procedure BufferShiftRight(var buf: TBuffer; count: integer); 
procedure BufferShiftLeft(var buf: TBuffer; count: integer; RealSize: integer); 
procedure BufferToBuffer(var bufTo, bufFrom: TBuffer; index: integer; count: integer; indTo: integer); 
procedure BufferWriteString(var buf: TBuffer; s: string; index: integer); 
procedure BufferWriteDword(var buf: TBuffer; d: integer; index: integer); 
procedure BufferWriteWord(var buf: TBuffer; d: integer; index: integer); 
procedure BufferWriteDwordRev(var buf: TBuffer; d: integer; index: integer); 
procedure BufferWriteByte(var buf: TBuffer; b: byte; index: integer); 
procedure BufferWriteBuffer(var bufTo, bufFrom: TBuffer; indTo: integer); 
function BufferSearchString(var buf: TBuffer; str: string; offs: integer): integer; 
function BufferSearchStringRev(var buf: TBuffer; str: string; offs: integer): integer; 
function BufferSearchDword(var buf: TBuffer; d: integer; offs: integer): integer; 
 
 
implementation 
 
function DwordToStr(d: integer):string; 
begin 
  DwordToStr := Chr((d AND $000000FF)) + Chr((d AND $0000FF00) SHR 8) + Chr((d AND $00FF0000) SHR 16) + Chr((d AND $FF000000) SHR 24); 
end; 
 
function StrToDword(s: string):integer; 
begin 
  StrToDword := Ord(s[1]) + (Ord(s[2]) SHL 8) + (Ord(s[3]) SHL 16) + (Ord(s[4]) SHL 24); 
end; 
 
function HexNum(c: char):byte; 
var b: byte; 
begin 
  b := 0; 
  case c of 
    '1': b := 1;  '2': b := 2;  '3': b := 3;  '4': b := 4; 
    '5': b := 5;  '6': b := 6;  '7': b := 7;  '8': b := 8; 
    '9': b := 9;  'A': b := 10; 'B': b := 11; 'C': b := 12; 
    'D': b := 13; 'E': b := 14; 'F': b := 15; 
  end; 
  HexNum := b; 
end; 
 
function DwordReverse(var d: integer):integer; 
begin 
  DwordReverse := ((d SHL 24) AND $FF000000) + ((d SHL 8) AND $00FF0000) + ((d SHR 8) AND $0000FF00) + ((d SHR 24) AND $000000FF); 
end; 
 
procedure HexStringToBuffer(var buf: TBuffer; s: string; StartPos: integer); 
var i, index: integer; 
begin 
  i := 0; 
  index := 0; 
  Repeat 
    i := i + 1; 
    if (s[i] <> ' ') and (s[i+1] <> ' ') then 
      begin 
        buf[StartPos + index] := Chr(HexNum(s[i]) * 16 + HexNum(s[i+1])); 
        index := index + 1; 
        i := i + 1; 
      end; 
  until i >= Length(s); 
end; 
 
function BufferToDwordRev(var buf: TBuffer; index: integer):integer; 
begin 
  BufferToDwordRev := Ord(buf[index + 3]) SHL 24 + Ord(buf[index + 2]) SHL 16 + Ord(buf[index + 1]) SHL 8 + Ord(buf[index]); 
end; 
 
function BufferToDword(var buf: TBuffer; index: integer):integer; 
begin 
  BufferToDword :=  Ord(buf[index]) SHL 24 + Ord(buf[index + 1]) SHL 16 + Ord(buf[index + 2]) SHL 8 + Ord(buf[index + 3]); 
end; 
 
function BufferToByte(var buf: TBuffer; index: integer):byte; 
begin 
  BufferToByte := Ord(buf[index]); 
end; 
 
function BufferToString(var buf: TBuffer; index: integer; count: integer):string; 
var i: integer; 
    s: string; 
begin 
  s := StringOfChar(' ', count); 
  for i := index to index + count - 1 do 
    begin 
      s[i - index + 1] := buf[i]; 
    end; 
  BufferToString := s; 
end; 
 
procedure BufferShiftRight(var buf: TBuffer; count: integer); 
var i: integer; 
begin 
  for i := Length(buf) - 1 downto count do buf[i] := buf[i - count]; 
  for i := 0 to count - 1 do buf[i] := Chr(0); 
end; 
 
procedure BufferShiftLeft(var buf: TBuffer; count: integer; RealSize: integer); 
var i: integer; 
begin 
  for i := 0 to RealSize - count - 1 do buf[i] := buf[i + count]; 
  for i := RealSize - count - 1 to RealSize - 1 do buf[i] := Chr(0); 
end; 
 
procedure BufferToBuffer(var bufTo, bufFrom: TBuffer; index: integer; count: integer; indTo: integer); 
var i: integer; 
begin 
  for i := index to index + count - 1 do 
    begin 
      bufTo[i - index + indTo] := bufFrom[i]; 
    end; 
end; 
 
procedure BufferWriteString(var buf: TBuffer; s: string; index: integer); 
var i: integer; 
begin 
  for i := index to index + Length(s) - 1 do 
    begin 
      buf[i] := s[i - index + 1]; 
    end; 
end; 
 
procedure BufferWriteDword(var buf: TBuffer; d: integer; index: integer); 
begin 
  buf[index + 3] := Chr(d AND $000000FF); 
  buf[index + 2] := Chr((d SHR 8) AND $000000FF); 
  buf[index + 1] := Chr((d SHR 16) AND $000000FF); 
  buf[index + 0] := Chr((d SHR 24) AND $000000FF); 
end; 
 
procedure BufferWriteWord(var buf: TBuffer; d: integer; index: integer); 
begin 
  buf[index + 1] := Chr(d AND $000000FF); 
  buf[index + 0] := Chr((d SHR 8) AND $000000FF); 
end; 
 
procedure BufferWriteDwordRev(var buf: TBuffer; d: integer; index: integer); 
begin 
  buf[index + 0] := Chr(d AND $000000FF); 
  buf[index + 1] := Chr((d SHR 8) AND $000000FF); 
  buf[index + 2] := Chr((d SHR 16) AND $000000FF); 
  buf[index + 3] := Chr((d SHR 24) AND $000000FF); 
end; 
 
procedure BufferWriteByte(var buf: TBuffer; b: byte; index: integer); 
begin 
  buf[index] := Chr(b); 
end; 
 
procedure BufferWriteBuffer(var bufTo, bufFrom: TBuffer; indTo: integer); 
var i: integer; 
begin 
  for i := indTo to indTo + Length(bufFrom) - 1 do 
    bufTo[i] := bufFrom[i - indTo]; 
end; 
 
function BufferSearchString(var buf: TBuffer; str: string; offs: integer): integer; 
var i: integer; 
begin 
  for i := offs to Length(buf) - Length(str) - 1 do 
    begin 
      if (str = BufferToString(buf, i, Length(str))) then 
        begin 
          BufferSearchString := i; 
          Exit; 
        end; 
    end; 
  BufferSearchString := -1; 
end; 
 
function BufferSearchStringRev(var buf: TBuffer; str: string; offs: integer): integer; 
var i: integer; 
begin 
  for i := offs downto 0 do 
    begin 
      if (str = BufferToString(buf, i, Length(str))) then 
        begin 
          BufferSearchStringRev := i; 
          Exit; 
        end; 
    end; 
  BufferSearchStringRev := -1; 
end; 
 
function BufferSearchDword(var buf: TBuffer; d: integer; offs: integer): integer; 
var i: integer; 
begin 
  for i := offs to Length(buf) - 4 - 1 do 
    begin 
      if (d = BufferToDword(buf, i)) then 
        begin 
          BufferSearchDword := i; 
          Exit; 
        end; 
    end; 
  BufferSearchDword := -1; 
end; 
 
end.