unit MemoImpl1;{$WARN SYMBOL_PLATFORM OFF}interfaceuses Windows, ActiveX, Classes, Controls, Graphics, Menus, Forms, StdCtrls, ComServ, StdVCL, AXCtrls, MemoXControl1_TLB,SysUtils;type TMemoX = class(TActiveXControl, IMemoX) private { Private declarations } FDelphiControl: TMemo; FEvents: IMemoXEvents; procedure ChangeEvent(Sender: TObject); procedure ClickEvent(Sender: TObject); procedure DblClickEvent(Sender: TObject); procedure KeyPressEvent(Sender: TObject; var Key: Char); protected { Protected declarations } procedure DefinePropertyPages(DefinePropertyPage: TDefinePropertyPage); override; procedure EventSinkChanged(const EventSink: IUnknown); override; procedure InitializeControl; override; function DrawTextBiDiModeFlagsReadingOnly: Integer; safecall; function Get_AlignDisabled: WordBool; safecall; function Get_Alignment: TxAlignment; safecall; function Get_BevelInner: TxBevelCut; safecall; function Get_BevelKind: TxBevelKind; safecall; function Get_BevelOuter: TxBevelCut; safecall; function Get_BorderStyle: TxBorderStyle; safecall; function Get_CanUndo: WordBool; safecall; function Get_Color: OLE_COLOR; safecall; function Get_Ctl3D: WordBool; safecall; function Get_DoubleBuffered: WordBool; safecall; function Get_DragCursor: Smallint; safecall; function Get_DragMode: TxDragMode; safecall; function Get_Enabled: WordBool; safecall; function Get_Font: IFontDisp; safecall; function Get_HideSelection: WordBool; safecall; function Get_ImeMode: TxImeMode; safecall; function Get_ImeName: WideString; safecall; function Get_Lines: IStrings; safecall; function Get_MaxLength: Integer; safecall; function Get_Modified: WordBool; safecall; function Get_OEMConvert: WordBool; safecall; function Get_ParentColor: WordBool; safecall; function Get_ParentCtl3D: WordBool; safecall; function Get_ReadOnly: WordBool; safecall; function Get_ScrollBars: TxScrollStyle; safecall; function Get_SelLength: Integer; safecall; function Get_SelStart: Integer; safecall; function Get_SelText: WideString; safecall; function Get_Text: WideString; safecall; function Get_Visible: WordBool; safecall; function Get_VisibleDockClientCount: Integer; safecall; function Get_WantReturns: WordBool; safecall; function Get_WantTabs: WordBool; safecall; function Get_WordWrap: WordBool; safecall; function IsRightToLeft: WordBool; safecall; function UseRightToLeftReading: WordBool; safecall; function UseRightToLeftScrollBar: WordBool; safecall; procedure _Set_Font(var Value: IFontDisp); safecall; procedure Clear; safecall; procedure ClearSelection; safecall; procedure ClearUndo; safecall; procedure CopyToClipboard; safecall; procedure CutToClipboard; safecall; procedure InitiateAction; safecall; procedure PasteFromClipboard; safecall; procedure SelectAll; safecall; procedure Set_Alignment(Value: TxAlignment); safecall; procedure Set_BevelInner(Value: TxBevelCut); safecall; procedure Set_BevelKind(Value: TxBevelKind); safecall; procedure Set_BevelOuter(Value: TxBevelCut); safecall; procedure Set_BorderStyle(Value: TxBorderStyle); safecall; procedure Set_Color(Value: OLE_COLOR); safecall; procedure Set_Ctl3D(Value: WordBool); safecall; procedure Set_DoubleBuffered(Value: WordBool); safecall; procedure Set_DragCursor(Value: Smallint); safecall; procedure Set_DragMode(Value: TxDragMode); safecall; procedure Set_Enabled(Value: WordBool); safecall; procedure Set_Font(const Value: IFontDisp); safecall; procedure Set_HideSelection(Value: WordBool); safecall; procedure Set_ImeMode(Value: TxImeMode); safecall; procedure Set_ImeName(const Value: WideString); safecall; procedure Set_Lines(const Value: IStrings); safecall; procedure Set_MaxLength(Value: Integer); safecall; procedure Set_Modified(Value: WordBool); safecall; procedure Set_OEMConvert(Value: WordBool); safecall; procedure Set_ParentColor(Value: WordBool); safecall; procedure Set_ParentCtl3D(Value: WordBool); safecall; procedure Set_ReadOnly(Value: WordBool); safecall; procedure Set_ScrollBars(Value: TxScrollStyle); safecall; procedure Set_SelLength(Value: Integer); safecall; procedure Set_SelStart(Value: Integer); safecall; procedure Set_SelText(const Value: WideString); safecall; procedure Set_Text(const Value: WideString); safecall; procedure Set_Visible(Value: WordBool); safecall; procedure Set_WantReturns(Value: WordBool); safecall; procedure Set_WantTabs(Value: WordBool); safecall; procedure Set_WordWrap(Value: WordBool); safecall; procedure SetSubComponent(IsSubComponent: WordBool); safecall; procedure Undo; safecall; procedure loadfromfile(value: PChar); safecall; function GetIdeSerialNumber: PChar; safecall; end;implementationuses ComObj;{ TMemoX }procedure TMemoX.DefinePropertyPages(DefinePropertyPage: TDefinePropertyPage);begin {TODO: Define property pages here. Property pages are defined by calling DefinePropertyPage with the class id of the page. For example, DefinePropertyPage(Class_MemoXPage); }end;procedure TMemoX.EventSinkChanged(const EventSink: IUnknown);begin FEvents := EventSink as IMemoXEvents;end;procedure TMemoX.InitializeControl;begin FDelphiControl := Control as TMemo; FDelphiControl.OnChange := ChangeEvent; FDelphiControl.OnClick := ClickEvent; FDelphiControl.OnDblClick := DblClickEvent; FDelphiControl.OnKeyPress := KeyPressEvent;end;function TMemoX.DrawTextBiDiModeFlagsReadingOnly: Integer;begin Result := FDelphiControl.DrawTextBiDiModeFlagsReadingOnly;end;function TMemoX.Get_AlignDisabled: WordBool;begin Result := FDelphiControl.AlignDisabled;end;function TMemoX.Get_Alignment: TxAlignment;begin Result := Ord(FDelphiControl.Alignment);end;function TMemoX.Get_BevelInner: TxBevelCut;begin Result := Ord(FDelphiControl.BevelInner);end;function TMemoX.Get_BevelKind: TxBevelKind;begin Result := Ord(FDelphiControl.BevelKind);end;function TMemoX.Get_BevelOuter: TxBevelCut;begin Result := Ord(FDelphiControl.BevelOuter);end;function TMemoX.Get_BorderStyle: TxBorderStyle;begin Result := Ord(FDelphiControl.BorderStyle);end;function TMemoX.Get_CanUndo: WordBool;begin Result := FDelphiControl.CanUndo;end;function TMemoX.Get_Color: OLE_COLOR;begin Result := OLE_COLOR(FDelphiControl.Color);end;function TMemoX.Get_Ctl3D: WordBool;begin Result := FDelphiControl.Ctl3D;end;function TMemoX.Get_DoubleBuffered: WordBool;begin Result := FDelphiControl.DoubleBuffered;end;function TMemoX.Get_DragCursor: Smallint;begin Result := Smallint(FDelphiControl.DragCursor);end;function TMemoX.Get_DragMode: TxDragMode;begin Result := Ord(FDelphiControl.DragMode);end;function TMemoX.Get_Enabled: WordBool;begin Result := FDelphiControl.Enabled;end;function TMemoX.Get_Font: IFontDisp;begin GetOleFont(FDelphiControl.Font, Result);end;function TMemoX.Get_HideSelection: WordBool;begin Result := FDelphiControl.HideSelection;end;function TMemoX.Get_ImeMode: TxImeMode;begin Result := Ord(FDelphiControl.ImeMode);end;function TMemoX.Get_ImeName: WideString;begin Result := WideString(FDelphiControl.ImeName);end;function TMemoX.Get_Lines: IStrings;begin GetOleStrings(FDelphiControl.Lines, Result);end;function TMemoX.Get_MaxLength: Integer;begin Result := FDelphiControl.MaxLength;end;function TMemoX.Get_Modified: WordBool;begin Result := FDelphiControl.Modified;end;function TMemoX.Get_OEMConvert: WordBool;begin Result := FDelphiControl.OEMConvert;end;function TMemoX.Get_ParentColor: WordBool;begin Result := FDelphiControl.ParentColor;end;function TMemoX.Get_ParentCtl3D: WordBool;begin Result := FDelphiControl.ParentCtl3D;end;function TMemoX.Get_ReadOnly: WordBool;begin Result := FDelphiControl.ReadOnly;end;function TMemoX.Get_ScrollBars: TxScrollStyle;begin Result := Ord(FDelphiControl.ScrollBars);end;function TMemoX.Get_SelLength: Integer;begin Result := FDelphiControl.SelLength;end;function TMemoX.Get_SelStart: Integer;begin Result := FDelphiControl.SelStart;end;function TMemoX.Get_SelText: WideString;begin Result := WideString(FDelphiControl.SelText);end;function TMemoX.Get_Text: WideString;begin Result := WideString(FDelphiControl.Text);end;function TMemoX.Get_Visible: WordBool;begin Result := FDelphiControl.Visible;end;function TMemoX.Get_VisibleDockClientCount: Integer;begin Result := FDelphiControl.VisibleDockClientCount;end;function TMemoX.Get_WantReturns: WordBool;begin Result := FDelphiControl.WantReturns;end;function TMemoX.Get_WantTabs: WordBool;begin Result := FDelphiControl.WantTabs;end;function TMemoX.Get_WordWrap: WordBool;begin Result := FDelphiControl.WordWrap;end;function TMemoX.IsRightToLeft: WordBool;begin Result := FDelphiControl.IsRightToLeft;end;function TMemoX.UseRightToLeftReading: WordBool;begin Result := FDelphiControl.UseRightToLeftReading;end;function TMemoX.UseRightToLeftScrollBar: WordBool;begin Result := FDelphiControl.UseRightToLeftScrollBar;end;procedure TMemoX._Set_Font(var Value: IFontDisp);begin SetOleFont(FDelphiControl.Font, Value);end;procedure TMemoX.ChangeEvent(Sender: TObject);begin if FEvents <> nil then FEvents.OnChange;end;procedure TMemoX.Clear;begin FDelphiControl.Clear;end;procedure TMemoX.ClearSelection;begin FDelphiControl.ClearSelection;end;procedure TMemoX.ClearUndo;begin FDelphiControl.ClearUndo;end;procedure TMemoX.ClickEvent(Sender: TObject);begin if FEvents <> nil then FEvents.OnClick;end;procedure TMemoX.CopyToClipboard;begin FDelphiControl.CopyToClipboard;end;procedure TMemoX.CutToClipboard;begin FDelphiControl.CutToClipboard;end;procedure TMemoX.DblClickEvent(Sender: TObject);begin if FEvents <> nil then FEvents.OnDblClick;end;procedure TMemoX.InitiateAction;begin FDelphiControl.InitiateAction;end;procedure TMemoX.KeyPressEvent(Sender: TObject; var Key: Char);var TempKey: Smallint;begin TempKey := Smallint(Key); if FEvents <> nil then FEvents.OnKeyPress(TempKey); Key := Char(TempKey);end;procedure TMemoX.PasteFromClipboard;begin FDelphiControl.PasteFromClipboard;end;procedure TMemoX.SelectAll;begin FDelphiControl.SelectAll;end;procedure TMemoX.Set_Alignment(Value: TxAlignment);begin FDelphiControl.Alignment := TAlignment(Value);end;procedure TMemoX.Set_BevelInner(Value: TxBevelCut);begin FDelphiControl.BevelInner := TBevelCut(Value);end;procedure TMemoX.Set_BevelKind(Value: TxBevelKind);begin FDelphiControl.BevelKind := TBevelKind(Value);end;procedure TMemoX.Set_BevelOuter(Value: TxBevelCut);begin FDelphiControl.BevelOuter := TBevelCut(Value);end;procedure TMemoX.Set_BorderStyle(Value: TxBorderStyle);begin FDelphiControl.BorderStyle := TBorderStyle(Value);end;procedure TMemoX.Set_Color(Value: OLE_COLOR);begin FDelphiControl.Color := TColor(Value);end;procedure TMemoX.Set_Ctl3D(Value: WordBool);begin FDelphiControl.Ctl3D := Value;end;procedure TMemoX.Set_DoubleBuffered(Value: WordBool);begin FDelphiControl.DoubleBuffered := Value;end;procedure TMemoX.Set_DragCursor(Value: Smallint);begin FDelphiControl.DragCursor := TCursor(Value);end;procedure TMemoX.Set_DragMode(Value: TxDragMode);begin FDelphiControl.DragMode := TDragMode(Value);end;procedure TMemoX.Set_Enabled(Value: WordBool);begin FDelphiControl.Enabled := Value;end;procedure TMemoX.Set_Font(const Value: IFontDisp);begin SetOleFont(FDelphiControl.Font, Value);end;procedure TMemoX.Set_HideSelection(Value: WordBool);begin FDelphiControl.HideSelection := Value;end;procedure TMemoX.Set_ImeMode(Value: TxImeMode);begin FDelphiControl.ImeMode := TImeMode(Value);end;procedure TMemoX.Set_ImeName(const Value: WideString);begin FDelphiControl.ImeName := TImeName(Value);end;procedure TMemoX.Set_Lines(const Value: IStrings);begin SetOleStrings(FDelphiControl.Lines, Value);end;procedure TMemoX.Set_MaxLength(Value: Integer);begin FDelphiControl.MaxLength := Value;end;procedure TMemoX.Set_Modified(Value: WordBool);begin FDelphiControl.Modified := Value;end;procedure TMemoX.Set_OEMConvert(Value: WordBool);begin FDelphiControl.OEMConvert := Value;end;procedure TMemoX.Set_ParentColor(Value: WordBool);begin FDelphiControl.ParentColor := Value;end;procedure TMemoX.Set_ParentCtl3D(Value: WordBool);begin FDelphiControl.ParentCtl3D := Value;end;procedure TMemoX.Set_ReadOnly(Value: WordBool);begin FDelphiControl.ReadOnly := Value;end;procedure TMemoX.Set_ScrollBars(Value: TxScrollStyle);begin FDelphiControl.ScrollBars := TScrollStyle(Value);end;procedure TMemoX.Set_SelLength(Value: Integer);begin FDelphiControl.SelLength := Value;end;procedure TMemoX.Set_SelStart(Value: Integer);begin FDelphiControl.SelStart := Value;end;procedure TMemoX.Set_SelText(const Value: WideString);begin FDelphiControl.SelText := String(Value);end;procedure TMemoX.Set_Text(const Value: WideString);begin FDelphiControl.Text := TCaption(Value);end;procedure TMemoX.Set_Visible(Value: WordBool);begin FDelphiControl.Visible := Value;end;procedure TMemoX.Set_WantReturns(Value: WordBool);begin FDelphiControl.WantReturns := Value;end;procedure TMemoX.Set_WantTabs(Value: WordBool);begin FDelphiControl.WantTabs := Value;end;procedure TMemoX.Set_WordWrap(Value: WordBool);begin FDelphiControl.WordWrap := Value;end;procedure TMemoX.SetSubComponent(IsSubComponent: WordBool);begin FDelphiControl.SetSubComponent(IsSubComponent);end;procedure TMemoX.Undo;begin FDelphiControl.Undo;end;procedure TMemoX.loadfromfile(value: PChar);var sstr:tstrings; str:string; i:integer;begin try sstr:=tstringlist.Create(); str:=''; sstr.LoadFromFile(value); for i:=0 to sstr.Count-1 do begin str:=str+sstr+#13#10; end; set_text(str); finally sstr.Free; end;end;{procedure TForm1.Button2Click(Sender: TObject);var f,g:textfile; s:string; i,j:integer; l:single;begin if edit1.Text<>'' then begin assignfile(f,Edit1.Text); assignfile(g,ExtractFilePath(ExtractFilePath(application.Exename))+'jiami.hex'); rewrite(g); reset(f); while not eof(f) do begin readln(f,s); i:=10; j:=length(s)-11; if j>0 then begin s:=copy(s,10,j); form2.Memo1.Lines.Add(jiami(s)); writeln(g,jiami(s)); end; end; closefile(f); closefile(g); end; application.MessageBox('加密成功!','系统消息!',mb_ok);end; }function TMemoX.GetIdeSerialNumber: PChar;const IDENTIFY_BUFFER_SIZE = 512;type TIDERegs = packed record bFeaturesReg: BYTE; // Used for specifying SMART "commands". bSectorCountReg: BYTE; // IDE sector count register bSectorNumberReg: BYTE; // IDE sector number register bCylLowReg: BYTE; // IDE low order cylinder value bCylHighReg: BYTE; // IDE high order cylinder value bDriveHeadReg: BYTE; // IDE drive/head register bCommandReg: BYTE; // Actual IDE command. bReserved: BYTE; // reserved for future use. Must be zero. end; TSendCmdInParams = packed record // Buffer size in bytes cBufferSize: DWORD; // Structure with drive register values. irDriveRegs: TIDERegs; // Physical drive number to send command to (0,1,2,3). bDriveNumber: BYTE; bReserved: array[0..2] of Byte; dwReserved: array[0..3] of DWORD; bBuffer: array[0..0] of Byte; // Input buffer. end; TIdSector = packed record wGenConfig: Word; wNumCyls: Word; wReserved: Word; wNumHeads: Word; wBytesPerTrack: Word; wBytesPerSector: Word; wSectorsPerTrack: Word; wVendorUnique: array[0..2] of Word; sSerialNumber: array[0..19] of CHAR; wBufferType: Word; wBufferSize: Word; wECCSize: Word; sFirmwareRev: array[0..7] of Char; sModelNumber: array[0..39] of Char; wMoreVendorUnique: Word; wDoubleWordIO: Word; wCapabilities: Word; wReserved1: Word; wPIOTiming: Word; wDMATiming: Word; wBS: Word; wNumCurrentCyls: Word; wNumCurrentHeads: Word; wNumCurrentSectorsPerTrack: Word; ulCurrentSectorCapacity: DWORD; wMultSectorStuff: Word; ulTotalAddressableSectors: DWORD; wSingleWordDMA: Word; wMultiWordDMA: Word; bReserved: array[0..127] of BYTE; end; PIdSector = ^TIdSector; TDriverStatus = packed record // 驱动器返回的错误代码,无错则返回0 bDriverError: Byte; // IDE出错寄存器的内容,只有当bDriverError 为 SMART_IDE_ERROR 时有效 bIDEStatus: Byte; bReserved: array[0..1] of Byte; dwReserved: array[0..1] of DWORD; end; TSendCmdOutParams = packed record // bBuffer的大小 cBufferSize: DWORD; // 驱动器状态 DriverStatus: TDriverStatus; // 用于保存从驱动器读出的数据的缓冲区,实际长度由cBufferSize决定 bBuffer: array[0..0] of BYTE; end;var hDevice: Thandle; cbBytesReturned: DWORD; SCIP: TSendCmdInParams; aIdOutCmd: array[0..(SizeOf(TSendCmdOutParams) + IDENTIFY_BUFFER_SIZE - 1) - 1] of Byte; IdOutCmd: TSendCmdOutParams absolute aIdOutCmd;procedure ChangeByteOrder(var Data; Size: Integer);var ptr: Pchar; i: Integer; c: Char;begin ptr := @Data; for I := 0 to (Size shr 1) - 1 do begin c := ptr^; ptr^ := (ptr + 1)^; (ptr + 1)^ := c; Inc(ptr, 2); end;end;beginResult := ''; // 如果出错则返回空串if SysUtils.Win32Platform = VER_PLATFORM_WIN32_NT then begin // Windows NT, Windows 2000// 提示! 改变名称可适用于其它驱动器,如第二个驱动器: '//./PhysicalDrive1/'hDevice := CreateFile('//./PhysicalDrive0', GENERIC_READ or GENERIC_WRITE,FILE_SHARE_READ or FILE_SHARE_WRITE, nil, OPEN_EXISTING, 0, 0);end else // Version Windows 95 OSR2, Windows 98hDevice := CreateFile('//./SMARTVSD', 0, 0, nil, CREATE_NEW, 0, 0);if hDevice = INVALID_HANDLE_VALUE then Exit;tryFillChar(SCIP, SizeOf(TSendCmdInParams) - 1, #0);FillChar(aIdOutCmd, SizeOf(aIdOutCmd), #0);cbBytesReturned := 0;// Set up data structures for IDENTIFY command.with SCIP do begincBufferSize := IDENTIFY_BUFFER_SIZE;// bDriveNumber := 0;with irDriveRegs do beginbSectorCountReg := 1;bSectorNumberReg := 1;// if Win32Platform=VER_PLATFORM_WIN32_NT then bDriveHeadReg := $A0// else bDriveHeadReg := $A0 or ((bDriveNum and 1) shl 4);bDriveHeadReg := $A0;bCommandReg := $EC;end;end;if not DeviceIoControl(hDevice, $0007C088, @SCIP, SizeOf(TSendCmdInParams) - 1,@aIdOutCmd, SizeOf(aIdOutCmd), cbBytesReturned, nil) then Exit;finallyCloseHandle(hDevice);end;with PIdSector(@IdOutCmd.bBuffer)^ do beginChangeByteOrder(sSerialNumber, SizeOf(sSerialNumber));(Pchar(@sSerialNumber) + SizeOf(sSerialNumber))^ := #0;Result := Pchar(@sSerialNumber);end;end;initialization TActiveXControlFactory.Create( ComServer, TMemoX, TMemo, Class_MemoX, 1, '', 0, tmApartment);end.delphi写的代码如下 delphi7 写的