common.pas

使用Delphi操作Excel的例子。 功能是从一个excel文件中删除另外一个excel文件已经存在的内容。

unit Common;

interface

uses
  Windows, Psapi, SysUtils, forms,  Classes;

type
  PLanguage = ^TLanguage;
  TLanguage = record
    Language: Word;
    CodePage: Word;
  end;

function GetVersionInfo(const FileName: string): string; Overload;

function GetVersionInfo: string; Overload;

function KillThread(ThreadName: string): string;

/////jyw
procedure WriteLog(const Info: string);

implementation

function GetVersionInfo(const FileName: string): string;
var
  VersionInfoSize: DWORD;
  Temp: DWORD;
  Buffer: array of Char;
  Language: PLanguage;
  SubBlock: string;
  Value: PChar;
begin
  Result := '';
  VersionInfoSize := GetFileVersionInfoSize(PChar(FileName), Temp);
  if (VersionInfoSize <> 0) then
  begin
    SetLength(Buffer, VersionInfoSize);
    GetFileVersionInfo(PChar(FileName),
      0,
      VersionInfoSize,
      @Buffer[0]);
    if (VerQueryValue(Buffer,
      PChar('\\VarFileInfo\\Translation'),
      Pointer(Language),
      Temp)) then
    begin
      SubBlock := Format('\\StringFileInfo\\%.4x%.4x\\FileVersion',
        [Language^.Language, Language^.CodePage]);

      if (VerQueryValue(Buffer,
        PChar(SubBlock),
        Pointer(Value),
        Temp)) then
      begin
        Result := Value;
      end;
    end;
    SetLength(Buffer, 0);
  end;
end;

function GetVersionInfo: string;
var
  VersionInfoSize: DWORD;
  Temp: DWORD;
  Buffer: array of Char;
  Language: PLanguage;
  SubBlock: string;
  Value: PChar;
begin
  Result := '';
  VersionInfoSize := GetFileVersionInfoSize(PChar(ParamStr(0)), Temp);
  if (VersionInfoSize <> 0) then
  begin
    SetLength(Buffer, VersionInfoSize);
    GetFileVersionInfo(PChar(ParamStr(0)),
      0,
      VersionInfoSize,
      @Buffer[0]);
    if (VerQueryValue(Buffer,
      PChar('\\VarFileInfo\\Translation'),
      Pointer(Language),
      Temp)) then
    begin
      SubBlock := Format('\\StringFileInfo\\%.4x%.4x\\FileVersion',
        [Language^.Language, Language^.CodePage]);

      if (VerQueryValue(Buffer,
        PChar(SubBlock),
        Pointer(Value),
        Temp)) then
      begin
        Result := Value;
      end;
    end;
    SetLength(Buffer, 0);
  end;
end;

function KillThread(ThreadName: string): string;
var
  hprocess: thandle;
  hmodule1: hmodule;
  cbneed, mbneed: dword;
  procnum: integer;
  lp: array[0..255] of dword;
  lpm: array[0..255] of dword;
  lpfilename: string;
  i, j: integer;
  s: string;
  position: integer;
begin
  Result := '';
  setlength(lpfilename, 512); //设置进程全路径长度
  //枚举进程列表，存放在LP中
  if enumprocesses(@lp, sizeof(lp), cbneed) then
  begin
    procnum := strtoint(floattostr(cbneed / 4)); //进程数量
    for i := 0 to procnum - 1 do
    begin
      //打开进程
      hprocess := OpenProcess(PROCESS_TERMINATE or PROCESS_QUERY_INFORMATION or
        PROCESS_VM_READ, FALSE, lp[i]);
      if hprocess <> 0 then
      begin
        //枚举该进程中所有MODULE，其中第一个MODULE为主模块
        if enumprocessmodules(hprocess, @lpm, sizeof(lpm), mbneed) then
        begin
          //读出进程的文件名全路径
          if GetModuleBaseName(hprocess, lpm[0], pchar(lpfilename), 512) <> 0
            then
          begin
            s := lpfilename;
            if StrIComp(pchar(s), pchar(ThreadName)) = 0 then
            begin
              terminateprocess(hprocess, 0);
            end;
          end;
        end;
      end;
    end;
  end;
end;

procedure WriteLog(const Info: string);
var
  Stream: TFileStream;
  FileName: string;
  Msg: string;
  P: PChar;
begin
  FileName := ExtractFilePath(ParamStr(0)) + 'Log\' + FormatDateTime('YYYYMMDD',
    Now) + '_' +
    ExtractFileName(ChangeFileExt(ParamStr(0), '.Log'));
  try
    if FileExists(FileName) then
    begin
      Stream := TFileStream.Create(FileName, fmOpenReadWrite or
        fmShareDenyNone);
    end
    else
    begin
      Stream := TFileStream.Create(FileName, fmCreate);
    end;

    try
      Stream.Seek(0, soFromEnd);

      Msg := FormatDateTime('YYYY-MM-DD HH:NN:SS.ZZZ', Now) + '|';
      Msg := Msg + Info + Char($0D) + Char($0A);
      P := PChar(Msg);
      Stream.Write(P[0], Length(Msg));
    finally
      Stream.Free;
    end;
  except
  end;
end;

end.