main.pas

1.简繁相互转换 2.文件批量处理 3.可直接转换数据库字段

//          begin
//            stemp := GBToBIG5A(sList[i]);
//          end
//          else
//          begin
//            stemp := GBToBIG5(sList[i]);
//          end;
          stemp := GBToBIG5(sList[i]);
        end
        else
        begin
          stemp := DfmToBig5(sList[i]);
        end;
        sListDe.Add(stemp);
      end;
      if Trim(MemSubDir.AsString) = '' then
      begin
        sListDe.SaveToFile(edtDeDir.Text + MemFileName.AsString);
      end
      else
      begin
        if not DirectoryExists(edtDeDir.Text + MemSubDir.AsString) then
        begin
          CreateDir(edtDeDir.Text + MemSubDir.AsString);
        end;
        sListDe.SaveToFile(edtDeDir.Text + MemSubDir.AsString + '\' + MemFileName.AsString);
      end;
    end;
    iCount := iCount + 1;
    if (iCount > 5) and (not m_bReg) then
    begin
      Application.MessageBox(PChar('未注册只完成5个！'), PChar('提示'), MB_OK + MB_ICONINFORMATION);
      Break;
    end;
    Mem.Next;
    Application.ProcessMessages;
  end;
  Mem.First;
  sList.Free;
  sListDe.Free;
  Screen.Cursor := crDefault;
  Application.MessageBox(PChar('完成！'), PChar('提示'), MB_OK + MB_ICONINFORMATION);
end;

procedure TfrmMain.btnOpenDataClick(Sender: TObject);
var
  sCon: string;
  SL: TStrings;
  index: Integer;
begin
  ADOConnection1.ConnectionString := 'Provider=Microsoft.Jet.OLEDB.4.0;Data Source=' + ExtractFilePath(Application.ExeName)
    + 'Song.Dat;Persist Security Info=False;Jet OLEDB:Database Password=;';
  sCon := PromptDataSource(Application.Handle, ADOConnection1.ConnectionString);
  try
    ADOConnection1.Close;
    ADOConnection1.ConnectionString := sCon;
    ADOConnection1.Open;
    SL := TStringList.Create;
    ADOConnection1.GetTableNames(SL, False);
    while MemTableName.RecordCount > 0 do
    begin
      MemTableName.Delete;
    end;
    for index := 0 to (SL.Count - 1) do
    begin
      MemTableName.Append;
      MemTableNameIsSelected.AsBoolean := False;
      MemTableNameName.AsString := SL[index];
      MemTableName.Post;
    end;
  except
    ShowMessage('出错');
  end;
end;

procedure TfrmMain.btnDataTranClick(Sender: TObject);
var
  sSQL: string;
  i, iCount: Integer;
  sTemp: string;
begin
  if MemTableName.RecordCount = 0 then
  begin
    Exit;
  end;
  Screen.Cursor := crHourGlass;
  MemTableName.First;
  while not MemTableName.Eof do
  begin
    if MemTableNameIsSelected.AsBoolean then
    begin
      sSQL := 'select * from ' + MemTableNameName.AsString;
      if SetAdoQue(ADOQuery1, sSQL) then
      begin
        iCount := ADOQuery1.FieldCount;
        ADOQuery1.First;
        while not ADOQuery1.Eof do
        begin
          ADOQuery1.Edit;
          for i := 0 to iCount - 1 do
          begin
            if ((ADOQuery1.Fields[i].DataType = ftString) or
              (ADOQuery1.Fields[i].DataType = ftWideString) or
              (ADOQuery1.Fields[i].DataType = ftMemo))
              and (not ADOQuery1.Fields[i].IsNull) then
            begin
              if cbInt.Checked then
              begin
                sTemp := Gb2Big5A(ADOQuery1.FieldByName(ADOQuery1.Fields[i].FieldName).AsString);
              end
              else
              begin
                sTemp := Gb2Big5(ADOQuery1.FieldByName(ADOQuery1.Fields[i].FieldName).AsString);
              end;
              if not m_bReg then
              begin
                sTemp := sTemp + '未注册';
              end;
              ADOQuery1.FieldByName(ADOQuery1.Fields[i].FieldName).AsString := sTemp;
            end;
          end;
          ADOQuery1.Post;
          ADOQuery1.Next;
        end;
      end;
    end;
    MemTableName.Next;
    Application.ProcessMessages;
  end;
  MemTableName.First;
  Screen.Cursor := crDefault;
  Application.MessageBox(PChar('完成！'), PChar('提示'), MB_OK + MB_ICONINFORMATION);
end;

procedure TfrmMain.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  Mem.Free;
  MemTableName.Free;
  if ADOConnection1.Connected then
  begin
    ADOConnection1.Close;
  end;
end;

procedure TfrmMain.btnAllClick(Sender: TObject);
begin
  if Mem.RecordCount = 0 then
  begin
    Exit;
  end;
  Mem.First;
  while not Mem.Eof do
  begin
    Mem.Edit;
    MemIsSelected.AsBoolean := True;
    Mem.Post;
    Mem.Next;
  end;
  Mem.First;
end;

procedure TfrmMain.btnClearClick(Sender: TObject);
begin
  if Mem.RecordCount = 0 then
  begin
    Exit;
  end;
  Mem.First;
  while not Mem.Eof do
  begin
    Mem.Edit;
    MemIsSelected.AsBoolean := False;
    Mem.Post;
    Mem.Next;
  end;
  Mem.First;
end;

procedure TfrmMain.btnSingleBig5ToGBClick(Sender: TObject);
var
  i: Integer;
  sList: TStrings;
  stemp: string;
begin
  if memoSinleFile.Lines.Count = 0 then
  begin
    Exit;
  end;
  sList := TStringList.Create;
  for i := 0 to memoSinleFile.Lines.Count - 1 do
  begin
    if m_bPas then
    begin
      stemp := BIG5ToGB(memoSinleFile.Lines[i]);
    end
    else
    begin
      stemp := DfmToGB(memoSinleFile.Lines[i]);
    end;
    sList.Add(stemp);
  end;
  memoSinleFile.Clear;
  memoSinleFile.Lines.Assign(sList);
  sList.Free;
  memoSinleFile.Font.Charset := GB2312_CHARSET;
  memoSinleFile.Font.Name := '新宋体';
  Application.MessageBox(PChar('完成！'), PChar('提示'), MB_OK + MB_ICONINFORMATION);
end;

function TfrmMain.DfmToGB(Str: string): string;
var
  sTmp, sBig5: string;
  i, j, iLen: Integer;
  sResult: string;
begin
  sTmp := Str;
  if AnsiContainsText(sTmp, 'Font.Charset') then
  begin
    i := Pos('F', sTmp);
    Result := Copy(sTmp, 1, i - 1) + 'Font.Charset = GB2312_CHARSET';
    Exit;
  end
  else
    if AnsiContainsText(sTmp, 'Font.Name') then
    begin
      i := Pos('F', sTmp);
      Result := Copy(sTmp, 1, i - 1) + 'Font.Name = #23435#20307';
      Exit;
    end
    else
    begin
      sResult := '';
      iLen := Length(sTmp);
      i := 1;
      while i <= iLen do
      begin
        if sTmp[i] = '#' then
        begin
          sResult := sResult + '#';
          for j := i + 1 to iLen do
          begin
            if not (sTmp[j] in ['0'..'9']) then
            begin
              Break;
            end;
          end;
          if j <= iLen + 1 then
          begin

            sBig5 := Copy(sTmp, i + 1, j - i - 1);
            if Trim(sBig5) <> '' then
            begin
              if HasBig5Code(sBig5) then
              begin
                sResult := sResult + sBig5;
              end
              else
              begin
                sResult := sResult + sBig5;
              end;
            end;

            i := j;
          end
          else
          begin
            sResult := sResult + Copy(sTmp, i + 1, iLen - i);
            Result := sResult;
            Exit;
          end;
        end
        else
        begin
          sResult := sResult + sTmp[i];
          i := i + 1;
        end;
      end;
    end;
  Result := sResult;
end;

function TfrmMain.HasBig5Code(var Str: string): Boolean;
var
  i: Integer;
  iLen: Integer;
begin
  Result := False;
  iLen := Length(Str);
  for i := 1 to iLen do
  begin
    if not (Str[i] in ['0'..'9']) then
    begin
      Exit;
    end;
  end;
  //Str := GBUnicodeToGig5Unicode(Str);
  Str := Big5UnicodeToGBUnicode(Str);
  Result := True;
end;

procedure TfrmMain.btnDirBig5ToGBClick(Sender: TObject);
var
  i, iCount: Integer;
  sList, sListDe: TStrings;
  stemp: string;
begin
  if Mem.RecordCount = 0 then
  begin
    Exit;
  end;
  Screen.Cursor := crHourGlass;
  sList := TStringList.Create;
  sListDe := TStringList.Create;
  Mem.First;
  iCount := 0;
  while not Mem.Eof do
  begin

    if MemIsSelected.AsBoolean then
    begin
      sList.Clear;
      sListDe.Clear;
      m_bPas := not AnsiContainsText(MemFileName.AsString, '.dfm');
      sList.LoadFromFile(MemFullPath.AsString + MemFileName.AsString);
      for i := 0 to sList.Count - 1 do
      begin
        if m_bPas then
        begin
//          if cbIntDir.Checked then
//          begin
//            stemp := BIG5ToGBA(sList[i]);
//          end
//          else
//          begin
//            stemp := BIG5ToGB(sList[i]);
//          end;
          stemp := BIG5ToGB(sList[i]);
        end
        else
        begin
          stemp := DfmToGB(sList[i]);
        end;
        sListDe.Add(stemp);
      end;
      if Trim(MemSubDir.AsString) = '' then
      begin
        sListDe.SaveToFile(edtDeDir.Text + MemFileName.AsString);
      end
      else
      begin
        if not DirectoryExists(edtDeDir.Text + MemSubDir.AsString) then
        begin
          CreateDir(edtDeDir.Text + MemSubDir.AsString);
        end;
        sListDe.SaveToFile(edtDeDir.Text + MemSubDir.AsString + '\' + MemFileName.AsString);
      end;
    end;
    iCount := iCount + 1;
    if (iCount > 5) and (not m_bReg) then
    begin
      Application.MessageBox(PChar('未注册只完成5个！'), PChar('提示'), MB_OK + MB_ICONINFORMATION);
      Break;
    end;
    Mem.Next;
    Application.ProcessMessages;
  end;
  Mem.First;
  sList.Free;
  sListDe.Free;
  Screen.Cursor := crDefault;
  Application.MessageBox(PChar('完成！'), PChar('提示'), MB_OK + MB_ICONINFORMATION);
end;

procedure TfrmMain.btnDataBig5ToGBClick(Sender: TObject);
var
  sSQL: string;
  i, iCount: Integer;
  sTemp: string;
begin
  if MemTableName.RecordCount = 0 then
  begin
    Exit;
  end;
  Screen.Cursor := crHourGlass;
  MemTableName.First;
  while not MemTableName.Eof do
  begin
    if MemTableNameIsSelected.AsBoolean then
    begin
      sSQL := 'select * from ' + MemTableNameName.AsString;
      if SetAdoQue(ADOQuery1, sSQL) then
      begin
        iCount := ADOQuery1.FieldCount;
        ADOQuery1.First;
        while not ADOQuery1.Eof do
        begin
          ADOQuery1.Edit;
          for i := 0 to iCount - 1 do
          begin
            if ((ADOQuery1.Fields[i].DataType = ftString)
              or (ADOQuery1.Fields[i].DataType = ftWideString)
              or (ADOQuery1.Fields[i].DataType = ftMemo))
              and (not ADOQuery1.Fields[i].IsNull) then
            begin
              if cbInt.Checked then
              begin
                sTemp := Big52GbA(ADOQuery1.FieldByName(ADOQuery1.Fields[i].FieldName).AsString);
              end
              else
              begin
                sTemp := Big52Gb(ADOQuery1.FieldByName(ADOQuery1.Fields[i].FieldName).AsString);
              end;
              if not m_bReg then
              begin
                sTemp := sTemp + '未注册';
              end;
              ADOQuery1.FieldByName(ADOQuery1.Fields[i].FieldName).AsString := sTemp;

            end;
          end;
          ADOQuery1.Post;
          ADOQuery1.Next;
        end;
      end;
    end;
    MemTableName.Next;
    Application.ProcessMessages;
  end;
  MemTableName.First;
  Screen.Cursor := crDefault;
  Application.MessageBox(PChar('完成！'), PChar('提示'), MB_OK + MB_ICONINFORMATION);
end;

procedure TfrmMain.btnDataAllClick(Sender: TObject);
begin
  if MemTableName.RecordCount = 0 then
  begin
    Exit;
  end;
  MemTableName.First;
  while not MemTableName.Eof do
  begin
    MemTableName.Edit;
    MemTableNameIsSelected.AsBoolean := True;
    MemTableName.Post;
    MemTableName.Next;
  end;
  MemTableName.First;
end;

procedure TfrmMain.btnDataClearClick(Sender: TObject);
begin
  if MemTableName.RecordCount = 0 then
  begin
    Exit;
  end;
  MemTableName.First;
  while not MemTableName.Eof do
  begin
    MemTableName.Edit;
    MemTableNameIsSelected.AsBoolean := False;
    MemTableName.Post;
    MemTableName.Next;
  end;
  MemTableName.First;
end;

function TfrmMain.GetMacCode: string;
begin
  Result := EncryptStr(GetNetCardSN, '346268364');
end;

function TfrmMain.GetRegCode(Str: string): string;
begin
  Result := EncryptStr(Str, '665354lqx');
end;

procedure TfrmMain.btnRegClick(Sender: TObject);
var
  Reg: TRegistry;
begin
  if Trim(edtReg.Text) = '' then
  begin
    Exit;
  end;
  if Trim(edtReg.Text) = GetRegCode(m_sMac) then
  begin
    m_bReg := True;
    Self.Caption := '简繁转换器（已注册）';
    Reg := TRegistry.Create;
    reg.RootKey := HKEY_LOCAL_MACHINE;
    reg.OpenKey('SOFTWARE\LXSoftware', True);
    Reg.WriteString('LXRegCode', Trim(edtReg.Text));
    Reg.Free;
    Application.MessageBox(PChar('注册完成！'), PChar('提示'), MB_OK + MB_ICONINFORMATION);
  end
  else
  begin
    Application.MessageBox(PChar('注册失败！'), PChar('提示'), MB_OK + MB_ICONINFORMATION);
  end;
end;

end.