DELPHI盒子
!实时搜索: 盒子论坛 | 注册用户 | 修改信息 | 退出
检举帖 | 全文检索 | 关闭广告 | 捐赠
技术论坛
 用户名
 密  码
自动登陆(30天有效)
忘了密码
≡技术区≡
DELPHI技术
lazarus/fpc/Free Pascal
移动应用开发
Web应用开发
数据库专区
报表专区
网络通讯
开源项目
论坛精华贴
≡发布区≡
发布代码
发布控件
文档资料
经典工具
≡事务区≡
网站意见
盒子之家
招聘应聘
信息交换
论坛信息
最新加入: laohutou
今日帖子: 7
在线用户: 12
导航: 论坛 -> DELPHI技术 斑竹:liumazi,sephil  
作者:
男 lzgvcd (111) ★☆☆☆☆ -
盒子活跃会员
2004/2/6 10:38:15
标题:
看一下这段程序,请进 浏览:2434
加入我的收藏
楼主: function GetPYIndexChar( hzchar:string):char;
begin
  case WORD(hzchar[1]) shl 8 + WORD(hzchar[2]) of
    $B0A1..$B0C4 : result := 'A';
    $B0C5..$B2C0 : result := 'B';
    $B2C1..$B4ED : result := 'C';
    $B4EE..$B6E9 : result := 'D';
    $B6EA..$B7A1 : result := 'E';
    $B7A2..$B8C0 : result := 'F';
    $B8C1..$B9FD : result := 'G';
    $B9FE..$BBF6 : result := 'H';
    $BBF7..$BFA5 : result := 'J';
    $BFA6..$C0AB : result := 'K';
    $C0AC..$C2E7 : result := 'L';
    $C2E8..$C4C2 : result := 'M';
    $C4C3..$C5B5 : result := 'N';
    $C5B6..$C5BD : result := 'O';
    $C5BE..$C6D9 : result := 'P';
    $C6DA..$C8BA : result := 'Q';
    $C8BB..$C8F5 : result := 'R';
    $C8F6..$CBF9 : result := 'S';
    $CBFA..$CDD9 : result := 'T';
    $CDDA..$CEF3 : result := 'W';
    $CEF4..$D188 : result := 'X';
    $D1B9..$D4D0 : result := 'Y';
    $D4D1..$D7F9 : result := 'Z';
  else
    result := char(32);
  end;
end;前面的16进制是什么意思,请指点
----------------------------------------------
2222
作者:
男 bios (阿贡) ★☆☆☆☆ -
盒子中级会员
2004/2/6 11:10:58
1楼: 汉字的前半个字节的ASCII转换成 无符号长整形左移8,
和后半个字节的ASCII转换成 无符号长整形相加,
如果他们的数值落在前面的16进制给定的范围就认为是某个字母了
----------------------------------------------
按此在新窗口浏览图片
按此在新窗口浏览图片
作者:
男 bios (阿贡) ★☆☆☆☆ -
盒子中级会员
2004/2/6 11:16:29
2楼: 给这个:谁解释一下他的算法是什么意思:
function GetHzPy(const AHzStr: string): string;
const
  ChinaCode: array[0..25, 0..1] of Integer = ((1601, 1636), (1637, 1832), (1833, 2077),
    (2078, 2273), (2274, 2301), (2302, 2432), (2433, 2593), (2594, 2786), (9999, 0000),
    (2787, 3105), (3106, 3211), (3212, 3471), (3472, 3634), (3635, 3722), (3723, 3729),
    (3730, 3857), (3858, 4026), (4027, 4085), (4086, 4389), (4390, 4557), (9999, 0000),
    (9999, 0000), (4558, 4683), (4684, 4924), (4925, 5248), (5249, 5589));
var
  i, j, HzOrd: integer;
begin
  i := 1;
  while i <= Length(AHzStr) do
  begin
    if (AHzStr[i] >= #160) and (AHzStr[i + 1] >= #160) then
    begin
      HzOrd := (Ord(AHzStr[i]) - 160) * 100 + Ord(AHzStr[i + 1]) - 160;
      for j := 0 to 25 do
      begin
        if (HzOrd >= ChinaCode[j][0]) and (HzOrd <= ChinaCode[j][1]) then
        begin
          Result := Result + char(byte('A') + j);
          break;
        end;
      end;
      Inc(i);
    end else Result := Result + AHzStr[i];
    Inc(i);
  end;
end;


----------------------------------------------
按此在新窗口浏览图片
按此在新窗口浏览图片
作者:
男 axsoft (axsoft) ★☆☆☆☆ -
盒子活跃会员
2004/2/6 11:28:30
3楼: 获取拼音码。
----------------------------------------------
-
作者:
男 lzgvcd (111) ★☆☆☆☆ -
盒子活跃会员
2004/2/6 13:57:01
4楼: 我就是想知道这个16进制的值是从那里来的,
----------------------------------------------
2222
作者:
男 bjdribllec ( ) ★☆☆☆☆ -
盒子活跃会员
2004/2/6 14:42:02
5楼: 找一张汉字国标码表,目测一下。
但是在$D8A1后的汉字是以笔划排列的,这个方法就无能为力了。
----------------------------------------------
-
作者:
男 bios (阿贡) ★☆☆☆☆ -
盒子中级会员
2004/2/6 14:47:47
6楼: WORD(hzchar[1]) shl 8 + WORD(hzchar[2])
计算一下他的16进制位看看有没有落在他说的范围内?
----------------------------------------------
按此在新窗口浏览图片
按此在新窗口浏览图片
作者:
男 bios (阿贡) ★☆☆☆☆ -
盒子中级会员
2004/2/6 14:48:26
7楼: axsoft 大哥解释一下2楼算法的具体过程?谢谢啦!
----------------------------------------------
按此在新窗口浏览图片
按此在新窗口浏览图片
作者:
男 axsoft (axsoft) ★☆☆☆☆ -
盒子活跃会员
2004/2/6 14:54:56
8楼: 2楼是按区位码查找的,在区位码字典中,是按拼音排序的。如“啊”=1601。
详细的我也不是很清楚。
----------------------------------------------
-
作者:
男 bjdribllec ( ) ★☆☆☆☆ -
盒子活跃会员
2004/2/6 15:17:20
9楼: 贴张国标码表:

procedure TForm1.Button1Click(Sender: TObject);
var s1,s2:byte; ss,ss1:string;
begin
   with Memo1 do begin
      Font.Size:=12;
      Font.Name:='宋体';
      ScrollBar:=ssBoth;
      Lines.Clear;
   end;
   s1:=161;
   ss:='  |';
   ss1:='--+';
   while s1<254 do begin
      ss:=ss+IntToHex(s1,2)+'  ';
      ss1:=ss1+'----';
      inc(s1,2);
      if (s1 mod 10)=1 then begin
         ss:=ss+' ';
         ss1:=ss1+'-';
      end;
   end;
   Memo1.Lines.Add(ss);
   Memo1.Lines.Add(ss1);
   for s1:=161 to 247 do begin
      ss:=IntToHex(s1,2)+'|';
      for s2:=161 to 254 do begin
         ss:=ss+chr(s1)+chr(s2);
         if (s2 mod 10)=0 then ss:=ss+' ';
      end;
      Memo1.Lines.Add(ss);
      if (s1 mod 10)=0 then begin
         Memo1.Lines.Add('  |');
         Memo1.Lines.Add(Memo2.Lines[0]);
      end;
   end;
end;

----------------------------------------------
-
作者:
男 bios (阿贡) ★☆☆☆☆ -
盒子中级会员
2004/2/6 20:22:46
10楼: 老大这些是什么意思啊?
----------------------------------------------
按此在新窗口浏览图片
按此在新窗口浏览图片
作者:
男 lzgvcd (111) ★☆☆☆☆ -
盒子活跃会员
2004/2/7 9:59:40
11楼: unit unt_rundll;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls,inifiles;

type
  Tfrm_rundll = class(TForm)
    Button1: TButton;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    Function Reg:integer;
    Function Reg_kill:integer;
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  frm_rundll: Tfrm_rundll;

implementation

{$R *.DFM}

procedure Tfrm_rundll.Button1Click(Sender: TObject);
begin
  if reg=-1 then  application.Terminate;
end;





Function Tfrm_rundll.Reg;
type
  TFunc=function(A_sEditionFlag,A_allow_test,A_Email,A_URL,A_DISKKEY:pchar):pchar;
var
  string1:string;
  params:array[1..5]of string;
  p,i:integer;
  Menu_Table:string;
  DllName:string;
  DllParams:string;
  filename,FuncName:string;
  MenuCaption,str:string;
  Func:Tfunc;
  DllFunc:Thandle;
  evnOK:boolean;
  ret_value:string;
begin
    DllName:='dllreg.dll';

    if not(FileExists(extractfilepath(application.ExeName)+dllname)) then
    begin
       application.MessageBox('系统文件不完整,请重新安装','系统安全检查',48) ;
       application.Terminate ;
    end;

    filename:=extractfilename(DllName);
    FuncName:=copy(filename,4,pos('.',filename)-4);

    string1:=DllParams;
    for i:=1 to 5 do params[i]:=';

    for i:=1 to 4 do begin
       p:=pos('~',string1);
       if p=0 then begin
         params[i]:=trim(string1);
         break;
       end;

     params[i]:=copy(string1,1,p-1);

       string1:=copy(string1,p+1,length(string1)-p);
    end;

    params[1]:='TE10';//软件名版本号 -只能是字符不能超过3位
    params[2]:='10'; // 运行次数-只能是数字不能超过2位
    params[3]:='tjsoft@51.net?Subject=注册款已汇,申请注册XX程序注册号';
    params[4]:='http://tjsoft.51.net&#39;;
    params[5]:='True';


    evnOk:=true;

  if evnOK then begin
   DllFunc:=Loadlibrary(pchar(DllName));
   try
    if DllFunc<>0 then begin
       @Func:=GetProcAddress(DllFunc,pchar(FuncName));
         if @Func<>nil then begin
//调用DLL函数
          try
           ret_value:=Func(pchar(params[1]),pchar(params[2]),pchar(params[3]),pchar(params[4]),pchar('TRUE'));//
           if ret_value='DISKKEYTRUE' then
           begin
             result:=1;
//             showmessage('磁盘正式版ok');
           end;

           if ret_value='REGTRUE' then
           begin
             result:=11;
//             showmessage('注册号正式版ok');
           end;

           if ret_value='TEST' then
           begin
             result:=111;
//             G_Ver_test:=true;
//             showmessage('注册号试用版ok');
           end;

           if ret_value='-1' then
           begin
             result:=-1;
//             showmessage('出错啦');
           end;

           if (ret_value<>'DISKKEYTRUE') and (ret_value<>'REGTRUE') and
              (ret_value<>'TEST')
           then
           begin
             result:=strtoint(ret_value);
             application.MessageBox(pchar('还能运行次数:'+ret_value),pchar(caption),48)
           end;
          except
           raise;
          end;

         end;
     end;
   finally
     Freelibrary(DllFunc);
   end;

end;
end;



Function Tfrm_rundll.Reg_kill;
type
  TFunc=function(A_sEditionFlag,A_allow_test,A_Email,A_URL,A_DISKKEY:pchar):pchar;
var
  string1:string;
  params:array[1..5]of string;
  p,i:integer;
  Menu_Table:string;
  DllName:string;
  DllParams:string;
  filename,FuncName:string;
  MenuCaption,str:string;
  Func:Tfunc;
  DllFunc:Thandle;
  evnOK:boolean;
  ret_value:string;
begin
    DllName:='dllreg.dll';

    if not(FileExists(extractfilepath(application.ExeName)+dllname)) then
    begin
       application.MessageBox('系统文件不完整,请重新安装','系统安全检查',48) ;
       application.Terminate ;
    end;

    filename:=extractfilename(DllName);
    FuncName:=copy(filename,4,pos('.',filename)-4);

    string1:=DllParams;
    for i:=1 to 5 do params[i]:=';

    for i:=1 to 4 do begin
       p:=pos('~',string1);
       if p=0 then begin
         params[i]:=trim(string1);
         break;
       end;

     params[i]:=copy(string1,1,p-1);

       string1:=copy(string1,p+1,length(string1)-p);
    end;

    params[1]:='TE10';//软件名版本号 -只能是字符不能超过3位
    params[2]:='-999'; // 表示删除注册

    evnOk:=true;

  if evnOK then begin
   DllFunc:=Loadlibrary(pchar(DllName));
   try
    if DllFunc<>0 then begin
       @Func:=GetProcAddress(DllFunc,pchar(FuncName));
         if @Func<>nil then begin
//调用DLL函数
          try
           ret_value:=Func(pchar(params[1]),pchar(params[2]),pchar(params[3]),pchar(params[4]),pchar('TRUE'));//
          except
           raise;
          end;

         end;
     end;
   finally
     Freelibrary(DllFunc);
   end;

end;
end;



procedure Tfrm_rundll.Button2Click(Sender: TObject);
begin
  reg_kill;
end;

end.
----------------------------------------------
2222
作者:
男 lzgvcd (111) ★☆☆☆☆ -
盒子活跃会员
2004/2/7 10:04:14
12楼: 上面的程序是关于一个安装程序在注册,只能在一个机子上装一次,这是在网上看到的,希望大家发表自己的见解,谢谢,他是存储在dll文件里的
----------------------------------------------
2222
作者:
男 bios (阿贡) ★☆☆☆☆ -
盒子中级会员
2004/2/7 10:21:54
13楼: 按此在新窗口浏览图片
----------------------------------------------
按此在新窗口浏览图片
按此在新窗口浏览图片
作者:
男 lzgvcd (111) ★☆☆☆☆ -
盒子活跃会员
2004/2/7 11:30:35
14楼: TOOLClick(form1);其中tool是我的一个菜单按钮,我现在想在另一个窗体中调他,我这样用提示说不认识,我把另一个窗体的unit家到了要调的uses里,为什么还是提示出错,请指点
----------------------------------------------
2222
作者:
男 bios (阿贡) ★☆☆☆☆ -
盒子中级会员
2004/2/7 11:58:18
15楼: form1.TOOLClick(nil);
----------------------------------------------
按此在新窗口浏览图片
按此在新窗口浏览图片
作者:
男 lzgvcd (111) ★☆☆☆☆ -
盒子活跃会员
2004/2/10 9:07:45
16楼: 想问个关于客户端的程序问题,从客户端登陆服务器的时候,把服务器的ip地址放在什么地方,因为我现在要将程序安装到别人的机子上,他的ip地址我是不知道,不知道如何解决这个问题
----------------------------------------------
2222
信息
登陆以后才能回复
Copyright © 2CCC.Com 盒子论坛 v3.0.1 版权所有 页面执行941.4063毫秒 RSS