⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 unit1.pas

📁 很优秀的公交查询软件
💻 PAS
📖 第 1 页 / 共 2 页
字号:
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, WinSock, StdCtrls, ExtCtrls, ComCtrls, DateUtils;

const
  DMDBNAMELENGTH = 32;
  DBTYPE = 'BUS';
  CREATOR = 'ZHSp';
  DIRUP = 0;
  DIRDOWN = 1;
  STATIONLEN = 100;
  
type
(*
/************************************************************
* Structure of a Record entry
*************************************************************/
typedef struct {
	LocalID localChunkID; 	// local chunkID of a record
	UInt8 attributes; 	// record attributes;
	UInt8 uniqueID[3]; 	// unique ID of record; should
				// not be 0 for a legal record.
} RecordEntryType;

/************************************************************
* Structure of a Database Header
*************************************************************/
typedef struct {
	UInt8 name[dmDBNameLength]; 	// name of database
	UInt16 attributes; 		// database attributes
	UInt16 version; 		// version of database
	UInt32 creationDate; 		// creation date of database
	UInt32 modificationDate; 	// latest modification date
	UInt32 lastBackupDate; 		// latest backup date
	UInt32 modificationNumber; 	// modification number of database
	LocalID appInfoID; 		// application specific info
	LocalID sortInfoID; 		// app specific sorting info
	UInt32 type; 			// database type
	UInt32 creator; 		// database creator
	UInt32 uniqueIDSeed; 		// used to generate unique IDs.
					//Note that only the low order
					//3 bytes of this is used (in
					//RecordEntryType.uniqueID).
					//We are keeping 4 bytes for
					//alignment purposes.
	RecordListType recordList; 	// first record list
} DatabaseHdrType;
*)
  RecordEntryType = record
    localChunkID: LongWord;
    attributes: Word;
    uniqueID: Word;
  end;
  RecordListType = record
    nextRecordListID: LongWord;
    numRecords: Word;
  end;

  DatabaseHdrType = record
    name: array[0..DMDBNAMELENGTH - 1] of Char;
    attributes: Word;
    version: Word;
    creationDate: LongWord;
    modificationDate: LongWord;
    lastBackupDate: LongWord;
    modificationNumber: LongWord;
    appInfoID: LongWord;
    sortInfoID: LongWord;
    dbtype: LongWord;
    creator: array[0..3] of Char;
    uniqueIDSeed: LongWord;
  end;

  BaseRecordType = record
    CityName: String;//显示的城市名称,可以包括省份,如福建省厦门,厦门
    ProviderID: String;//原始提供者信息,如www.xm.gov.cn
    ProviderUpdateTime: String;//原始提供者最后更新时间,如2003-03-03
    CreatorID: String;//转换者ID,如沈晶冰@tompda
    CreatorUpdateTime: String;//转换者转换时间,如2003-03-24
    CreatorMemo: String;//转换者填写的其他信息,如:xxx
    Station: Word;
    Line: Word;
  end;

  LineData = record
    Index: Word;
    Dir: Byte;
    StationIndex: Byte;
  end;

  StationRecordType = record
    Station: String;
    Count: Byte;
    LineData: array[0..100] of LineData;
  end;

  LineRecordType = record
    Line: String;
    Dir: Byte;
    Count: Byte;
    LineData: array[0..200] of Word;
  end;


  TForm1 = class(TForm)
    meoResult: TMemo;
    PageControl1: TPageControl;
    TabSheet1: TTabSheet;
    TabSheet2: TTabSheet;
    meoLines: TMemo;
    Panel1: TPanel;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    Label7: TLabel;
    Bevel1: TBevel;
    Bevel2: TBevel;
    edtDatabaseFilename: TLabeledEdit;
    edtProviderID: TLabeledEdit;
    edtProviderUpdateTime: TLabeledEdit;
    edtCreatorID: TLabeledEdit;
    edtCreatorUpdateTime: TLabeledEdit;
    edtCreatorMemo: TLabeledEdit;
    edtCityName: TLabeledEdit;
    Panel2: TPanel;
    Label8: TLabel;
    Label9: TLabel;
    Button2: TButton;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
    msFile: TMemoryStream;
    lstStation: TList;
    lstLine: TList;
    lstRecordEntryOffset: TList;
    brtDatabaseInfo: BaseRecordType;

    procedure FillRecord();
    function getStationIndexFromlst(lst: TList; s: String): LongWord;
    procedure AllTablesSaveToFile;
    procedure LoadRecordEntryOffsetList;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
  msFile := TMemoryStream.Create;
  lstStation := TList.Create;
  lstLine := TList.Create;
  lstRecordEntryOffset := TList.Create;
  edtCreatorUpdateTime.Text := FormatDateTime('yyyy-mm-dd', Date);
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin

  msFile.Free;
  lstStation.Free;
  lstLine.Free;
  lstRecordEntryOffset.Free;
end;

function TForm1.getStationIndexFromlst(lst: TList; s: String): LongWord;
var
  pStation: ^StationRecordType;
  i: Integer;
begin
  Result := $FFFF;
  for i := 0 to lst.Count - 1 do
  begin
    pStation := lst.Items[i];
    if pStation^.Station = s Then
    begin
      Result := i;
      Break;
    end;
  end;

end;

procedure TForm1.Button2Click(Sender: TObject);
var
  fn: String;
  dbht: DatabaseHdrType;
  rlt: RecordListType;
//  ret: RecordEntryType;
  sdbFile: String;
begin
  if ('' = edtDatabaseFilename.Text) Or
    (1 <> Pos('BA_', edtDatabaseFilename.Text)) then
  begin
    ShowMessage('数据库名称为空或者格式不合格,推荐使用BA_开头!');
    pageControl1.ActivePageIndex := 0;
    edtDatabaseFileName.SetFocus;
    Exit;
  end;

  if ('' = edtCityName.Text) Then
  Begin
    ShowMessage('数据库显示为空,请填入地区名称!');
    pageControl1.ActivePageIndex := 0;
    edtCityName.SetFocus;
    Exit;
  End;

  if (mrNo = MessageDlg('转换时间可能很长,程序可能失去响应,这是正常现象,请耐心等待,转换完毕有提示(目前暂不放入进度条显示)。'#13#10'是否要继续?',
                    mtConfirmation, [mbYes, mbNo], 0)) then
    Exit;

//保存BaseRecordType
  brtDatabaseInfo.CityName := edtCityName.Text;
  brtDatabaseInfo.ProviderID := edtProviderID.Text;
  brtDatabaseInfo.ProviderUpdateTime := edtProviderUpdateTime.Text;
  brtDatabaseInfo.CreatorID := edtCreatorID.Text;
  brtDatabaseInfo.CreatorUpdateTime := edtCreatorUpdateTime.Text;
  brtDatabaseInfo.CreatorMemo := edtCreatorMemo.Text;



  sdbFile := Format('%s', [edtDatabaseFilename.Text]);
  fn := Format('%s%s.pdb',
          [ExtractFilePath(Application.ExeName),
          sdbFile]);
//file pdb file header
  with dbht do
  begin
    StrPCopy(name, sdbFile);
    attributes := 0;
    version := 1;
    creationDate := $534937BA;
    modificationDate := $534937BA;
    lastBackupDate := 0;
    modificationNumber := 0;
    appInfoID := 0;
    sortInfoID := 0;
//    StrPCopy(dbtype[1], DBTYPE);
    dbtype := $53554200;
    StrPCopy(creator, CREATOR);
    creator[0] := 'Z';
    creator[1] := 'H';
    creator[2] := 'S';
    creator[3] := 'p';
    uniqueIDSeed := 0;
  end;

  FillRecord;
  LoadRecordEntryOffsetList;
  with rlt do
  begin
    nextRecordListID := 0;
    numRecords := htons(1 + lstStation.Count + lstLine.Count);
  end;
  msFile.Clear;
  msFile.Write(dbht, SizeOf(dbht));
  msFile.Write(rlt, SizeOf(rlt.nextRecordListID) + SizeOf(rlt.numRecords));
  AllTablesSaveToFile;

  msFile.SaveToFile(fn);
  ShowMessage('转换完毕!可以发布了!');

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -