main.~pas

2,4,8,16进制转换

unit Main;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls,Types, CoolTrayIcon, ImgList, Menus,ShellApi,StrUtils;
type
  TFormMain = class(TForm)
    Btnstr: TButton;
    Edit1: TEdit;
    BtnHexs: TButton;
    RadioGroup1: TRadioGroup;
    Button3: TButton;
    Edit2: TEdit;
    Edit3: TEdit;
    Edit4: TEdit;
    Edit5: TEdit;
    Edit6: TEdit;
    MemoHEXS: TMemo;
    TrayIcon1: TCoolTrayIcon;
    PopupMenu1: TPopupMenu;
    ImageList2: TImageList;
    N1: TMenuItem;
    N5: TMenuItem;
    N4: TMenuItem;
    N7: TMenuItem;
    MemoSTR: TMemo;
    Button4: TButton;
    N2: TMenuItem;
    N3: TMenuItem;
    N6: TMenuItem;
    N8: TMenuItem;
    Label1: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    RadioGroup2: TRadioGroup;
    N9: TMenuItem;
    MemoHEXD: TMemo;
    MemoASCs: TMemo;
    BtnASC: TButton;
    Label3: TLabel;
    Label7: TLabel;
    MemoASCd: TMemo;
    BtnHexd: TButton;
    Label2: TLabel;
    BtnDecs: TButton;
    PopupMenu2: TPopupMenu;
    N10: TMenuItem;
    N11: TMenuItem;
    procedure RadioGroup1Click(Sender: TObject);
    procedure Edit1KeyPress(Sender: TObject; var Key: Char);
    procedure Edit1Change(Sender: TObject);
    procedure Edit2Change(Sender: TObject);
    procedure Edit3Change(Sender: TObject);
    procedure Edit4Change(Sender: TObject);
    procedure Edit2KeyPress(Sender: TObject; var Key: Char);
    procedure Edit3KeyPress(Sender: TObject; var Key: Char);
    procedure Edit4KeyPress(Sender: TObject; var Key: Char);
    procedure BtnstrClick(Sender: TObject);
    procedure BtnHexsClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure N1Click(Sender: TObject);
    procedure N2Click(Sender: TObject);
    procedure N5Click(Sender: TObject);
    procedure N3Click(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure TrayIcon1BalloonHintClick(Sender: TObject);
    procedure TrayIcon1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure Button3Click(Sender: TObject);
    procedure N8Click(Sender: TObject);
    procedure RadioGroup2Click(Sender: TObject);
    procedure BtnASCClick(Sender: TObject);
    procedure N9Click(Sender: TObject);
    procedure BtnDecsClick(Sender: TObject);
    procedure BtnHexdClick(Sender: TObject);
    procedure N10Click(Sender: TObject);
    procedure N11Click(Sender: TObject);
    
  private
    SessionEnding: Boolean;
    procedure WMQueryEndSession(var Message: TMessage); message WM_QUERYENDSESSION;
    procedure RadioGroupChange(OldType,NewType:integer);
    { Private declarations }
  public
    { Public declarations }
  end;

var
  FormMain: TFormMain;
  Curr_Type:integer=1;
  Int_Data:Int64=0;
  Formatstr:Char=',';
  Int_B:Integer=1;
  Int_A:Integer=0;
implementation

uses About;

{$R *.dfm}
function StrToInt(const S: string): Int64;
var
  E: Integer;
begin
if s<>'' then
  Val(S, Result, E)
else
   Result:=0;
end;  

function TypeToDec(Buffer: string;iTypes:SmallInt): string;
const ArrayHex_Char: array ['a'..'f'] of SmallInt =
    ( 10,11,12,13,14,15);
var
 i,itmp :integer;
 iDec:Int64;
 sBin :pchar;
begin
    iDec:=0;
    sBin:=Pchar(Buffer);
    if iTypes>10 then
    begin
       For i := 1 To Length(sBin) do
       begin
           if sBin[i-1] in ['a'..'f'] then
              itmp:=ArrayHex_Char[sBin[i-1]]
           else
              itmp:=StrToInt(sBin[i-1]);
           iDec:=iDec*iTypes+itmp;
        end ;
     end
     else
     begin
         For i := 1 To Length(sBin) do
         begin
             iDec:=iDec*iTypes+StrToInt(sBin[i-1]);
         end ;
     end;
    Result:=IntToStr(iDec);
end;
function DecToType(Buffer: string;iTypes:SmallInt): string ;
const ArrayHex_Char: array [0..15] of Char = '0123456789abcdef';
var
iDec:Int64;
begin
   iDec:=StrToInt(Buffer);
   Result :='';
   while iDec >0 do
   begin
       Result:=ArrayHex_Char[iDec Mod iTypes] + Result ;
       iDec:=iDec div iTypes;
   end;
   if Result='' then Result:='0';
end;

function TypeToType(Buffer: string;iTypesOld,iTypesNew:SmallInt): string;
var
tmpBuffer:string;
begin
if iTypesOld<>iTypesNew then
begin
   tmpBuffer:=TypeToDec(Buffer,iTypesOld);
   Int_data:=StrToInt(tmpBuffer);
   Result:=DecToType(tmpBuffer,iTypesNew);
end;
end;

function StrToAscII(Buffer: string): string;
var
i:integer;
sTmp1:Pchar;
sTmp2 : string;
begin
   Result:='';
   sTmp1:=Pchar(Buffer);
   sTmp2:=IntTostr(Ord(sTmp1[0]));
   for i:=1 to length(Buffer)-1 do
   begin
          sTmp2:=sTmp2 + Formatstr + IntTostr(Ord(sTmp1[i]));
   end;
   Result:=sTmp2;
end;
function StrToHex(Buffer: string): string;
var
i:integer;
sTmp1:Pchar;
sTmp2 : string;
begin
   Result:='';
   sTmp1:=Pchar(Buffer);
   sTmp2:=DecToType(IntTostr(Ord(sTmp1[0])),16);
   for i:=1 to length(Buffer)-1 do 
   begin
       sTmp2:=sTmp2 +Formatstr+ DecToType(IntTostr(Ord(sTmp1[i])),16);
   end;
   Result:=sTmp2;
end;

function StrToAscIID(Buffer: string): string;
var
i,BuffCount:integer;
sTmp1:Pchar;
sTmp2 : string;
iTmp:Int64;
begin
   Result:='0';
   sTmp1:=Pchar(Buffer);
   BuffCount:=length(Buffer);
   iTmp:=0;
   if BuffCount>0 then begin
      for i:=0 to BuffCount-1 do
      begin
          if i mod 2 = 0 then
          begin
             iTmp:= Ord(sTmp1[i])*(256-Int_A*255);
             if (i>0) and (i = BuffCount-1) then
                sTmp2:=sTmp2 + Formatstr + IntTostr(Ord(iTmp))
             else if (i=0) and (i = BuffCount-1) then
                sTmp2:=IntTostr(Ord(iTmp));
          end
          else
          begin
             iTmp:=iTmp + Ord(sTmp1[i])*(256-Int_B*255);
             if (i=1) and (i <= BuffCount-1) then
                sTmp2:=sTmp2 + IntTostr(Ord(iTmp))
             else
                sTmp2:=sTmp2 + Formatstr + IntTostr(Ord(iTmp));
          end;
      end;
      Result:=sTmp2;
   end;
end;
function StrToHexD(Buffer: string): string;
var
i,BuffCount:integer;
sTmp1:Pchar;
sTmp2 : string;
iTmp:Int64;
begin
   Result:='0';
   sTmp1:=Pchar(Buffer);
   BuffCount:=length(Buffer);
   iTmp:=0;
   if BuffCount>0 then begin
      for i:=0 to BuffCount-1 do
      begin
          if i mod 2 = 0 then
          begin
             iTmp:= Ord(sTmp1[i])*(256-Int_A*255);
             if (i>0) and (i = BuffCount-1) then
                sTmp2:=sTmp2 + Formatstr + DecToType(IntTostr(Ord(iTmp)),16)
             else if (i=0) and (i = BuffCount-1) then
                sTmp2:=DecToType(IntTostr(Ord(iTmp)),16);
          end
          else
          begin
             iTmp:=iTmp + Ord(sTmp1[i])*(256-Int_B*255);
             if (i=1) and (i <= BuffCount-1) then
                sTmp2:=sTmp2 + DecToType(IntTostr(Ord(iTmp)),16)
             else
                sTmp2:=sTmp2 + Formatstr + DecToType(IntTostr(Ord(iTmp)),16);
          end;
      end;
      Result:=sTmp2;
   end;
end;
//HexSToHexD
function HexSToHexD(Buffer: TstringList): string;
var
i:integer;
sTmp2 : string;
begin
   Result:='0';
   if Buffer.Count>0 then
   begin
      for i:=0 to Buffer.Count-1 do
          if Int_B =1 then
             sTmp2:=sTmp2 + Formatstr+copy(Buffer[i],1,2)+ Formatstr+copy(Buffer[i],3,2)
          else
             sTmp2:=sTmp2 + Formatstr+copy(Buffer[i],3,2)+ Formatstr+copy(Buffer[i],1,2);
      Result:=copy(sTmp2,2,Length(sTmp2));
   end;
end;
function AscIIDToAscIIS(Buffer: TstringList): string;
var
i,E,AscInt:integer;
sTmp2 : string;
begin
   Result:='0';
   if Buffer.Count>0 then
   begin
      for i:=0 to Buffer.Count-1 do
      begin
          Val(Buffer[i], AscInt, E);
          if (E = 0) and (AscInt>=0) then
          begin
             if Int_B=1 then
                sTmp2:=sTmp2+Formatstr+ IntToStr(AscInt div 256)+ Formatstr + IntToStr(AscInt mod 256)
             else 
                sTmp2:=sTmp2+Formatstr+ IntToStr(AscInt mod 256)+ Formatstr + IntToStr(AscInt div 256);
          end;
      end;
      Result:=copy(sTmp2,2,Length(sTmp2));
   end;
end;
function AscIIToStr(Buffer: TstringList): string;
var
i,E,AscInt:integer;
sTmp2 : string;
begin
   Result:='';
   for i:=0 to Buffer.Count-1 do
   begin
       Val(Buffer[i], AscInt, E);
       if (E = 0) and (AscInt>=0) and (AscInt<=255) then
          sTmp2:=sTmp2 + chr(StrToInt(Buffer[i]))
       else
       begin
          MessageBox(0, '输入的数据格式不正确！'+#13+'每个ASCII码之间请使用选定的分隔符分隔。', 'Error', MB_ICONERROR or MB_OK);
          Break;
       end;
   end;
   Result:=sTmp2;
end;
function HexToStr(Buffer: TstringList): string;
var
i,E,AscInt:integer;
sTmp2 : string;
begin
   Result:='';
   for i:=0 to Buffer.Count-1 do
   begin
       Val(TypeToDec(Buffer[i],16), AscInt, E);
       if (E = 0) and (AscInt>=0) and (AscInt<=255) then
          sTmp2:=sTmp2 + chr(StrToInt(TypeToDec(Buffer[i],16)))
       else
       begin
          MessageBox(0, '输入的数据格式不正确！'+#13+'每个ASCII码之间请使用选定的分隔符分隔。', 'Error', MB_ICONERROR or MB_OK);
          Break;
       end;
   end;
   Result:=sTmp2;
end;
function UpCase( ch : Char ) : Char;
begin
  Result := ch;
  case Result of
    'a'..'z':  Dec(Result, Ord('a') - Ord('A'));
  end;
end;
function LowerCase(ch:Char):Char;