凉风集 » Delphi http://www.lifangjin.com 李方进的个人BLOG Sun, 05 Feb 2012 15:36:06 +0000 en hourly 1 http://wordpress.org/?v=3.3.1 二三事 http://www.lifangjin.com/archives/581 http://www.lifangjin.com/archives/581#comments Mon, 10 Nov 2008 03:38:33 +0000 李 方进 http://www.lifangjin.com/?p=581 1.上周四晚应老婆科室的师兄邀请去解决一个代码问题。很奇怪是吧？为何医学专业的博士生需要自己写代码？一开始我也很疑惑，后来到了实验室以后我才知道，原来他们用的有一种实验仪器是电脑控制的，仪器厂在制造实验仪器的时候，还会开发一套用于电脑控制的软件，这个软件应该是delphi开发的，内置一个简单的脚本解析引擎，使用这个仪器的人只要写一些简单的脚本去实现实验操作步骤。由于该“师兄”完全没有编程经验，自己写的脚本都是根据范例自己改的，出现了没有按照预期步骤执行的效果，听老婆说我会编程于是就找我去看看问题出在哪里。脚本语言很简单，大约半小时以后我改了一下，顺便教了教。但是不确定是否改正确了，必须要根据实验步骤等待5小时左右才行确知最后的结果。周五上午老婆给我发了个短信说我改对了，现在实验步骤正常。哈，内心小小的虚荣了一把——咱好歹也给博士生上过一次课了。另外，我觉得似乎这类专注于某一非计算机领域的软件应用存在一定的开发价值，比方说，给这个仪器写一个仿真软件，然后做一个时间加速，这样在这个软件上不用花时间等待就能检验自己写的小脚本是否正确，还能节省其他的成本，比如药物。

2.破财消灾，老婆的MACBOOK进水了，我怀疑是主板烧了，网上查了下，换个主板大约要2000-3000元，有点郁闷。

]]> http://www.lifangjin.com/archives/581/feed 0 尝试在delphi开发过程中使用LUA进行扩展 http://www.lifangjin.com/archives/351 http://www.lifangjin.com/archives/351#comments Wed, 13 Jun 2007 07:27:04 +0000 李 方进 http://www.lifangjin.com/?p=351 使用的是lua for delphi扩展，文件共有5个，一个dll，4个pas。
lua版本是5.0.2，可以点击这里下载。
写了一个简单的demo，delphi主程序完成对lua扩展的加载，同时对用户输入的日期以及当前日期进行比较，lua文件完成对比较结果的文字化输出。代码如下：
test.

  1. function dayinfo(num)
  2. local strdayinfo;
  3. if (num==0) then
  4. strdayinfo="今天";
  5. elseif (num>0) then
  6. strdayinfo=num.."天前";
  7. elseif (num<0) then
  8. strdayinfo=math.abs(num).."天后";
  9. end
  10. print(strdayinfo);
  11. end


delphi主程序

  1. unit Unit1;
  2.  
  3. interface
  4.  
  5. uses
  6. Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  7. Dialogs, StdCtrls,DateUtils;
  8.  
  9. type
  10. TForm1 = class(TForm)
  11. Label1: TLabel;
  12. Button1: TButton;
  13. Edit1: TEdit;
  14. Memo1: TMemo;
  15. procedure FormCreate(Sender: TObject);
  16. procedure Button1Click(Sender: TObject);
  17. private
  18. { Private declarations }
  19. public
  20. { Public declarations }
  21. end;
  22.  
  23. var
  24. Form1: TForm1;
  25.  
  26. implementation
  27.  
  28. {$R *.dfm}
  29. uses
  30. lua, lualib, lauxlib, LuaUtils;
  31.  
  32. procedure TForm1.FormCreate(Sender: TObject);
  33. begin
  34. Edit1.Text:=datetostr(date());
  35. //Edit1.Text:=inttostr(DayOfTheYear(date()));
  36. end;
  37.  
  38. function LuaPrint(L: Plua_State): Integer; cdecl;
  39. var
  40. I, N: Integer;
  41. begin
  42. //LuaShowStack(L, 'fobOp:LuaPrint ?n?');
  43.  
  44. N := lua_gettop(L);
  45. for I := 1 to N do
  46. Form1.Label1.caption:=lua_tostring(L, I);
  47. Result := 0;
  48. end;
  49.  
  50. procedure TForm1.Button1Click(Sender: TObject);
  51. var
  52. L: Plua_State;
  53. begin
  54. // Label1.Caption:= inttostr(DayOfTheYear(date())-DayOfTheYear(strtodate(Edit1.Text)));
  55.  
  56. Memo1.Lines.LoadFromFile('test.lua');
  57. Memo1.Lines.Add('dayinfo('+inttostr(DayOfTheYear(date())-DayOfTheYear(strtodate(Edit1.Text)))+')');
  58. L := lua_open;
  59. try
  60. luaopen_math(L);
  61. LuaRegister(L, 'print', LuaPrint);
  62. LuaLoadBuffer(L, Memo1.Text, 'code');
  63. LuaPCall(L, 0, 0, 0);
  64. finally
  65. lua_close(L);
  66. end;
  67. end;
  68. end.

经测试成功，程序会在label1中根据用户输入的日期来输出是今天，还是n天前或者n天后。

]]> http://www.lifangjin.com/archives/351/feed 1 delphi和c#的MD5加密(32位) http://www.lifangjin.com/archives/91 http://www.lifangjin.com/archives/91#comments Fri, 24 Mar 2006 05:10:55 +0000 李 方进 http://www.lifangjin.com/?p=91 c#代码:
System.Web.Security.FormsAuthentication.HashPasswordForStoringInConfigFile(string ,”″);

delphi代码:
{*_* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *

Author:       Fran鏾is PIETTE. Based on work given by Louis S. Berman from
              BrainTree Ltd, lsb@braintree.com
Description:  MD5 is an implmentation for the MD5 Message-Digest Algorithm
              as described in RFC-1321
Creation:     October 11, 1997
Version:      1.03
EMail:        http://users.swing.be/francois.piette  francois.piette@swing.be
              http://www.rtfm.be/fpiette             francois.piette@rtfm.be
              francois.piette@pophost.eunet.be
Support:      Use the mailing list twsocket@rtfm.be See website for details.
Legal issues: Copyright (C) 1997, 1998 by Fran鏾is PIETTE
              Rue de Grady 24, 4053 Embourg, Belgium. Fax: +32-4-365.74.56
              <francois.piette@pophost.eunet.be>

              This software is provided ’as-is’, without any express or
              implied warranty.  In no event will the author be held liable
              for any  damages arising from the use of this software.

              Permission is granted to anyone to use this software for any
              purpose, including commercial applications, and to alter it
              and redistribute it freely, subject to the following
              restrictions:

              1. The origin of this software must not be misrepresented,
                 you must not claim that you wrote the original software.
                 If you use this software in a product, an acknowledgment
                 in the product documentation would be appreciated but is
                 not required.

              2. Altered source versions must be plainly marked as such, and
                 must not be misrepresented as being the original software.

              3. This notice may not be removed or altered from any source
                 distribution.

              4. You must register this software by sending a picture postcard
                 to the author. Use a nice stamp and mention your name, street
                 address, EMail address and any comment you like to say.

Updates:
Oct 26, 1997 Changed MD5Final form function to procedure to be compatible
             with C++Builder.
Jul 09, 1998 V1.01 Adapted for  4
Aug 06, 1998 V1.02 Added R- Q- directive
Jun 05, 1999 V1.03 Wolfgang Klein found a bug in MD5Update.

* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
unit MD5;

interface

uses
    SysUtils;

const
    MD5Version         = 102;
    CopyRight : String = ’ MD5 Message-Digest (c) 97-98 F. Piette V1.02 ’;

{$Q-}
{$R-}

type
    TMD5Context = record
        State: array[0..3] of LongInt;
        Count: array[0..1] of LongInt;
        case Integer of
        0: (BufChar: array[0..63] of Byte);
        1: (BufLong: array[0..15] of LongInt);
    end;
    TMD5Digest = array[0..15] of Char;

procedure MD5Init(var MD5Context: TMD5Context);
procedure MD5Update(var MD5Context: TMD5Context;
                    const Data;
                    Len: Integer);
procedure MD5Transform(var Buf: array of LongInt;
                       const Data: array of LongInt);
procedure MD5UpdateBuffer(var MD5Context: TMD5Context;
                          Buffer: Pointer;
                          BufSize: Integer);
procedure MD5Final(var Digest: TMD5Digest; var MD5Context: TMD5Context);

function GetMD5(Buffer: Pointer; BufSize: Integer): string;
function StrMD5(Buffer : String): string;

implementation

const
    MaxBufSize = 16384;

type
    PMD5Buffer = ^TMD5Buffer;
    TMD5Buffer = array[0..(MaxBufSize - 1)] of Char;

{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
{ MD5 initialization. Begins an MD5 operation, writing a new context.         }
procedure MD5Init(var MD5Context: TMD5Context);
begin
    FillChar(MD5Context, SizeOf(TMD5Context), #0);
    with MD5Context do begin
        { Load magic initialization constants. }
        State[0] := LongInt($67452301);
        State[1] := LongInt($EFCDAB89);
        State[2] := LongInt($98BADCFE);
        State[3] := LongInt($10325476);
    end
end;

{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
{ MD5 block update operation. Continues an MD5 message-digest operation,      }
{ processing another message block, and updating the context.                 }
procedure MD5Update(
    var MD5Context: TMD5Context;            { Context                         }
    const Data;                             { Input block                     }
    Len: Integer);                          { Length of input block           }
type
    TByteArray = array[0..0] of Byte;
var
    Index: Word;
    T: LongInt;
begin
    with MD5Context do begin
        T := Count[0];
        Inc(Count[0], LongInt(Len) shl 3);
        if Count[0] < T then
            Inc(Count[1]);
        Inc(Count[1], Len shr 29);
        T := (T shr 3) and $3F;
        Index := 0;
        if T <> 0 then begin
            Index := T;
            T := 64 - T;
            if Len < T then begin
                Move(Data, BufChar[Index], Len);
                Exit;
            end;
            Move(Data, BufChar[Index], T);
            MD5Transform(State, BufLong);
            Dec(Len, T);
            Index := T;  { Wolfgang Klein, 05/06/99 }
        end;
        while Len >= 64 do begin
            Move(TByteArray(Data)[Index], BufChar, 64);
            MD5Transform(State, BufLong);
            Inc(Index, 64);
            Dec(Len, 64);
        end;
        Move(TByteArray(Data)[Index], BufChar, Len);
    end
end;

{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
{ MD5 finalization. Ends an MD5 message-digest operation, writing the message }
{ digest and zeroizing the context.                                           }
procedure MD5Final(var Digest: TMD5Digest; var MD5Context: TMD5Context);
var
    Cnt : Word;
    P   : Byte;
begin
    with MD5Context do begin
        Cnt := (Count[0] shr 3) and $3F;
        P := Cnt;
        BufChar[P] := $80;
        Inc(P);
        Cnt := 64 - 1 - Cnt;
        if Cnt < 8 then begin
            FillChar(BufChar[P], Cnt, #0);
            MD5Transform(State, BufLong);
            FillChar(BufChar, 56, #0);
        end
        else
            FillChar(BufChar[P], Cnt - 8, #0);
        BufLong[14] := Count[0];
        BufLong[15] := Count[1];
        MD5Transform(State, BufLong);
        Move(State, Digest, 16)
    end;
    FillChar(MD5Context, SizeOf(TMD5Context), #0)
end;

{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
{ MD5 basic transformation. Transforms state based on block.                  }
procedure MD5Transform(
    var Buf: array of LongInt;
    const Data: array of LongInt);
var
    A, B, C, D: LongInt;

    procedure Round1(var W: LongInt; X, Y, Z, Data: LongInt; S: Byte);
    begin
        Inc(W, (Z xor (X and (Y xor Z))) + Data);
        W := (W shl S) or (W shr (32 - S));
        Inc(W, X)
    end;

    procedure Round2(var W: LongInt; X, Y, Z, Data: LongInt; S: Byte);
    begin
        Inc(W, (Y xor (Z and (X xor Y))) + Data);
        W := (W shl S) or (W shr (32 - S));
        Inc(W, X)
    end;

    procedure Round3(var W: LongInt; X, Y, Z, Data: LongInt; S: Byte);
    begin
        Inc(W, (X xor Y xor Z) + Data);
        W := (W shl S) or (W shr (32 - S));
        Inc(W, X)
    end;

    procedure Round4(var W: LongInt; X, Y, Z, Data: LongInt; S: Byte);
    begin
        Inc(W, (Y xor (X or not Z)) + Data);
        W := (W shl S) or (W shr (32 - S));
        Inc(W, X)
    end;
begin
    A := Buf[0];
    B := Buf[1];
    C := Buf[2];
    D := Buf[3];

    Round1(A, B, C, D, Data[ 0] + LongInt($d76aa478),  7);
    Round1(D, A, B, C, Data[ 1] + LongInt($e8c7b756), 12);
    Round1(C, D, A, B, Data[ 2] + LongInt($242070db), 17);
    Round1(B, C, D, A, Data[ 3] + LongInt($c1bdceee), 22);
    Round1(A, B, C, D, Data[ 4] + LongInt($f57c0faf),  7);
    Round1(D, A, B, C, Data[ 5] + LongInt($4787c62a), 12);
    Round1(C, D, A, B, Data[ 6] + LongInt($a8304613), 17);
    Round1(B, C, D, A, Data[ 7] + LongInt($fd469501), 22);
    Round1(A, B, C, D, Data[ 8] + LongInt($698098d8),  7);
    Round1(D, A, B, C, Data[ 9] + LongInt($8b44f7af), 12);
    Round1(C, D, A, B, Data[10] + LongInt($ffff5bb1), 17);
    Round1(B, C, D, A, Data[11] + LongInt($895cd7be), 22);
    Round1(A, B, C, D, Data[12] + LongInt($6b901122),  7);
    Round1(D, A, B, C, Data[13] + LongInt($fd987193), 12);
    Round1(C, D, A, B, Data[14] + LongInt($a679438e), 17);
    Round1(B, C, D, A, Data[15] + LongInt($49b40821), 22);

    Round2(A, B, C, D, Data[ 1] + LongInt($f61e2562),  5);
    Round2(D, A, B, C, Data[ 6] + LongInt($c040b340),  9);
    Round2(C, D, A, B, Data[11] + LongInt($265e5a51), 14);
    Round2(B, C, D, A, Data[ 0] + LongInt($e9b6c7aa), 20);
    Round2(A, B, C, D, Data[ 5] + LongInt($d62f105d),  5);
    Round2(D, A, B, C, Data[10] + LongInt($02441453),  9);
    Round2(C, D, A, B, Data[15] + LongInt($d8a1e681), 14);
    Round2(B, C, D, A, Data[ 4] + LongInt($e7d3fbc8), 20);
    Round2(A, B, C, D, Data[ 9] + LongInt($21e1cde6),  5);
    Round2(D, A, B, C, Data[14] + LongInt($c33707d6),  9);
    Round2(C, D, A, B, Data[ 3] + LongInt($f4d50d87), 14);
    Round2(B, C, D, A, Data[ 8] + LongInt($455a14ed), 20);
    Round2(A, B, C, D, Data[13] + LongInt($a9e3e905),  5);
    Round2(D, A, B, C, Data[ 2] + LongInt($fcefa3f8),  9);
    Round2(C, D, A, B, Data[ 7] + LongInt($676f02d9), 14);
    Round2(B, C, D, A, Data[12] + LongInt($8d2a4c8a), 20);

    Round3(A, B, C, D, Data[ 5] + LongInt($fffa3942),  4);
    Round3(D, A, B, C, Data[ 8] + LongInt($8771f681), 11);
    Round3(C, D, A, B, Data[11] + LongInt($6d9d6122), 16);
    Round3(B, C, D, A, Data[14] + LongInt($fde5380c), 23);
    Round3(A, B, C, D, Data[ 1] + LongInt($a4beea44),  4);
    Round3(D, A, B, C, Data[ 4] + LongInt($4bdecfa9), 11);
    Round3(C, D, A, B, Data[ 7] + LongInt($f6bb4b60), 16);
    Round3(B, C, D, A, Data[10] + LongInt($bebfbc70), 23);
    Round3(A, B, C, D, Data[13] + LongInt($289b7ec6),  4);
    Round3(D, A, B, C, Data[ 0] + LongInt($eaa127fa), 11);
    Round3(C, D, A, B, Data[ 3] + LongInt($d4ef3085), 16);
    Round3(B, C, D, A, Data[ 6] + LongInt($04881d05), 23);
    Round3(A, B, C, D, Data[ 9] + LongInt($d9d4d039),  4);
    Round3(D, A, B, C, Data[12] + LongInt($e6db99e5), 11);
    Round3(C, D, A, B, Data[15] + LongInt($1fa27cf8), 16);
    Round3(B, C, D, A, Data[ 2] + LongInt($c4ac5665), 23);

    Round4(A, B, C, D, Data[ 0] + LongInt($f4292244),  6);
    Round4(D, A, B, C, Data[ 7] + LongInt($432aff97), 10);
    Round4(C, D, A, B, Data[14] + LongInt($ab9423a7), 15);
    Round4(B, C, D, A, Data[ 5] + LongInt($fc93a039), 21);
    Round4(A, B, C, D, Data[12] + LongInt($655b59c3),  6);
    Round4(D, A, B, C, Data[ 3] + LongInt($8f0ccc92), 10);
    Round4(C, D, A, B, Data[10] + LongInt($ffeff47d), 15);
    Round4(B, C, D, A, Data[ 1] + LongInt($85845dd1), 21);
    Round4(A, B, C, D, Data[ 8] + LongInt($6fa87e4f),  6);
    Round4(D, A, B, C, Data[15] + LongInt($fe2ce6e0), 10);
    Round4(C, D, A, B, Data[ 6] + LongInt($a3014314), 15);
    Round4(B, C, D, A, Data[13] + LongInt($4e0811a1), 21);
    Round4(A, B, C, D, Data[ 4] + LongInt($f7537e82),  6);
    Round4(D, A, B, C, Data[11] + LongInt($bd3af235), 10);
    Round4(C, D, A, B, Data[ 2] + LongInt($2ad7d2bb), 15);
    Round4(B, C, D, A, Data[ 9] + LongInt($eb86d391), 21);

    Inc(Buf[0], A);
    Inc(Buf[1], B);
    Inc(Buf[2], C);
    Inc(Buf[3], D);
end;

{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure MD5UpdateBuffer(
    var MD5Context: TMD5Context;
    Buffer: Pointer;
    BufSize: Integer);
var
    BufTmp : PMD5Buffer;
    BufPtr : PChar;
    Bytes  : Word;
begin
    New(BufTmp);
    BufPtr := Buffer;
    try
        repeat
            if BufSize > MaxBufSize then
                Bytes := MaxBufSize
            else
                Bytes := BufSize;
            Move(BufPtr^, BufTmp^, Bytes);
            Inc(BufPtr, Bytes);
            Dec(BufSize, Bytes);
            if Bytes > 0 then
                MD5Update(MD5Context, BufTmp^, Bytes);
        until Bytes < MaxBufSize;
    finally
        Dispose(BufTmp);
    end;
end;

{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function GetMD5(Buffer: Pointer; BufSize: Integer): string;
var
    I          : Integer;
    MD5Digest  : TMD5Digest;
    MD5Context : TMD5Context;
begin
    for I := 0 to 15 do
        Byte(MD5Digest[I]) := I + 1;
    MD5Init(MD5Context);
    MD5UpdateBuffer(MD5Context, Buffer, BufSize);
    MD5Final(MD5Digest, MD5Context);
    Result := ”;
    for I := 0 to 15 do
        Result := Result + IntToHex(Byte(MD5Digest[I]), 2);
end;

{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function StrMD5(Buffer : String): string;
begin
    Result := GetMD5(@Buffer[1], Length(Buffer));
end;

{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

end.

两种方法32位MD5加密后的结果一样.
—–

]]> http://www.lifangjin.com/archives/91/feed 1 在delphi中调用webservice http://www.lifangjin.com/archives/89 http://www.lifangjin.com/archives/89#comments Thu, 02 Mar 2006 02:21:05 +0000 李 方进 http://www.lifangjin.com/?p=89 最近的一个项目需要用到这个技术，于是做了一个demo来验证可行性

webservice是用c#写的,提供三个操作:UserLevel 、UserDate、IsLogin

在delphi中使用webservice导入，以下为主程序：

  1. procedure TForm1.Btn_OkClick(Sender: TObject);
  2. var
  3.   strWSDL:string;
  4.   Iservice:Service1Soap;
  5.   msg:widestring;
  6.   strUsername:string;
  7.   strPassword:string;
  8.   IsLogin:boolean;
  9.   UserLevel:integer;
  10.   UserDate:string;
  11. begin
  12.   strWSDL:= Edit1.Text;
  13.   HTTPRIO1.WSDLLocation:=strWSDL;
  14.   strUsername:=EdtUserName.Text;
  15.   strPassword:=EdtPassword.Text;
  16.   //HTTPRIO1.HTTPWebNode.Agent := 'Borland SOAP 1.2';
  17.   //HTTPRIO1.HTTPWebNode.UseUTF8InHeader := true;
  18.   Iservice:= HTTPRIO1 as Service1Soap;
  19.   IsLogin:= Iservice.IsLogin(strUsername,strPassword);
  20.   if IsLogin=true then
  21.   begin
  22.   UserLevel:= Iservice.UserLevel(strUsername,strPassword);
  23.   UserDate:=  Iservice.UserDate(strUsername,strPassword);
  24.   msg:='登陆成功,到期时间为'+UserDate;
  25.   if UserLevel=2 then
  26.   begin
  27.     msg:=msg+'付费用户';
  28.     Edt_1.ReadOnly:=false;
  29.     Edt_2.ReadOnly:=false;
  30.     end
  31.   else
  32.   begin
  33.   msg:=msg+'免费用户';
  34.     Edt_1.ReadOnly:=true;
  35.     Edt_2.ReadOnly:=false;
  36.   end
  37.  
  38.   end
  39.   else
  40.   msg:='登陆失败,用户名或者密码错误';
  41.   LblMsg.Caption:=msg;
  42. end;
]]> http://www.lifangjin.com/archives/89/feed 1