发布一个小小的源码 StormRCPack
这个东西，其实简单得很！开发环境是Delphi2010，为减小体积，特地整合7z模块。我发布它源码的目的，就是希望大家能尽量搜集暴风影音的解码器，免费为各大媒体爱好者服务！在此，要感谢众多解码器的开发商～！
1 program StormRCPack;
2
3 uses
4 SysUtils,
5 Windows,
6 Forms,
7 Registry,
8 untMain in 'untMain.pas' {frmMain},
9 untPublic in 'untPublic.pas',
10 Thread_Run in 'Thread_Run.pas';
11
12 {$R *.res}
13
14 begin
15 SelfPath := ExtractFilePath(ParamStr(0));
16 with TRegistry.Create do
17 try
18 RootKey := HKEY_LOCAL_MACHINE;
19 if OpenKey('SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall\storm2', False) then
20 begin
21 StormPath := ReadString('DisplayIcon');
22 CloseKey;
23 end;
24 if StormPath = '' then
25 begin
26 MessageBox(
27 0,
28 PWideChar(TxtNotInstallStorm),
29 PWideChar(CptChkFileError),
30 MB_ICONERROR
31 );
32 end
33 else
34 begin
35 if not CheckFile(SelfPath + FN_7z) then
36 begin
37 MessageBox(0, PWideChar(Format(TxtChkFileError, [FN_7z])),
38 PWideChar(CptChkFileError), MB_ICONEXCLAMATION);
39 CanExit := True;
40 end;
41 if not CheckFile(SelfPath + FN_Real) then
42 begin
43 MessageBox(0, PWideChar(TxtChkFileError),
44 PWideChar(CptChkFileError), MB_ICONEXCLAMATION);
45 CanExit := True;
46 end;
47 if not CheckFile(SelfPath + FN_Codec) then
48 begin
49 MessageBox(0, PWideChar(TxtChkFileError),
50 PWideChar(CptChkFileError), MB_ICONEXCLAMATION);
51 CanExit := True;
52 end;
53 if CanExit then Application.Terminate
54 else
55 begin
56 Application.Initialize;
57 Application.MainFormOnTaskbar := True;
58 Application.CreateForm(TfrmMain, frmMain);
59 Application.Run;
60 end;
61 end;
62 finally
63 Free;
64 end;
65 end.
1 unit untMain;
2
3 interface
4
5 uses
6 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
7 Dialogs, StdCtrls, ComCtrls;
8
9 type
10 TfrmMain = class(TForm)
11 edt1: TEdit;
12 btn1: TButton;
13 lbl1: TLabel;
14 btn2: TButton;
15 grp1: TGroupBox;
16 rb1: TRadioButton;
17 rb2: TRadioButton;
18 procedure FormCreate(Sender: TObject);
19 procedure btn1Click(Sender: TObject);
20 procedure btn2Click(Sender: TObject);
21 private
22 { Private declarations }
23 public
24 { Public declarations }
25 end;
26
27 var
28 frmMain: TfrmMain;
29
30 implementation
31
32 uses
33 untPublic, Thread_Run;
34
35 {$R *.dfm}
36
37 procedure TfrmMain.btn1Click(Sender: TObject);
38 begin
39 edt1.Enabled := not edt1.Enabled;
40 if edt1.Enabled then
41 begin
42 StormPath := edt1.Text;
43 btn1.Caption := '完成输入！';
44 end
45 else
46 begin
47 btn1.Caption := '我要手动输入！';
48 end;
49 end;
50
51 procedure TfrmMain.btn2Click(Sender: TObject);
52 var
53 tsl: TStringList;
54 begin
55 btn2.Enabled := False;
56 try
57 tsl := TStringList.Create;
58 tsl.Add('郑重声明：');
59 tsl.Add(' 解码器所有权归开发商所有, Lofanmi本人不承担任何责任！');
60 tsl.Add('联系方式：');
61 tsl.Add(' 百度账号：你疯了啊');
62 tsl.Add(' 百度Hi群：1254253');
63 tsl.Add(' 技术QQ: 864657166 ');
64 tsl.Add(' Email: lofanmi@gmail.com');
65 tsl.Add(' MSN: lofanmi@msn.cn');
66 tsl.Add('Made by Lofanmi, L.S.O');
67 MessageBox(0, PWideChar(tsl.Text), PWideChar('关于软件'), MB_OK);
68 finally
69 FreeAndNil(tsl);
70 end;
71 TFileThread.Create(rb1.Checked);
72 while True do
73 begin
74 Application.ProcessMessages;
75 Sleep(50);
76 if CanExit then
77 begin
78 Application.Terminate;
79 Break;
80 end;
81 end;
82 end;
83
84 procedure TfrmMain.FormCreate(Sender: TObject);
85 begin
86 SelfPath := ExtractFilePath(ParamStr(0));
87 edt1.Text := StormPath;
88 top := (Screen.Height - Height) div 2;
89 Left := (Screen.Width - Width) div 2;
90 end;
91
92 end.
1 unit Thread_Run;
2
3 interface
4
5 uses
6 Windows, SysUtils, Classes, IdHashMessageDigest, sevenzip;
7
8 function UnpackAarchive(CodecType: Boolean): Boolean;
9
10 type
11 TFileThread = class(TThread)
12 private
13 InstallType: Boolean;
14 protected
15 procedure Execute; override;
16 public
17 constructor Create(CodecType: Boolean); overload;
18 end;
19
20 implementation
21
22 uses
23 untPublic;
24
25 constructor TFileThread.Create(CodecType: Boolean);
26 begin
27 InstallType := CodecType;
28 FreeOnTerminate := True;
29 inherited Create(False);
30 end;
31
32 procedure TFileThread.Execute;
33 begin
34 if UnpackAarchive(InstallType) then
35 begin
36 MessageBox(0, PWideChar('恭喜您~！解码器安装完成'), PWideChar('成功'), MB_ICONINFORMATION);
37 end;
38 CanExit := True;
39 end;
40
41 function UnpackAarchive(CodecType: Boolean): Boolean;
42 var
43 FPath: string;
44 begin
45 with CreateInArchive(CLSID_CFormat7z) do
46 begin
47 FPath := Copy(StormPath, 1, (Pos('Storm.exe', StormPath) - 1));
48 if CodecType then
49 begin
50 OpenFile(SelfPath + FN_Real);
51 ExtractTo(FPath);
52 end
53 else
54 begin
55 OpenFile(SelfPath + FN_Codec);
56 ExtractTo(FPath);
57 end;
58 end;
59 Result := True;
60 end;
61
62 end.
1 unit untPublic;
2
3 interface
4
5 uses
6 Windows, SysUtils, Classes, IdHashMessageDigest;
7
8 function CheckFile(const FFileName: string): Boolean;
9
10 const
11 Lib7zHash: string = 'CA41D56630191E61565A343C59695CA1';
12 PckRealHash: string = '1C2BFD22398A3D44B9C94DFA0D05C568';
13 PckCodecHash: string = 'FC4EE73AEEBB8D340AED471691326A12';
14
15 FN_7z: string = '7z.dll';
16 FN_Real: string = 'Real.dat';
17 FN_Codec: string = 'Codec.dat';
18
19 CptChkFileError: string = '错误！';
20 TxtChkFileError: string = '错误！找不到文件或文件校验失败！程序将自动退出！';
21 TxtNotInstallStorm: string = '错误！您的系统没有安装暴风影音！';
22
23 Real_Codec: Boolean = True;
24 All_Codec: Boolean = False;
25
26 var
27 StormPath: string;
28 SelfPath: string;
29 CanExit: Boolean;
30
31 implementation
32
33 function CheckFile(const FFileName: string): Boolean;
34 var
35 FHashString: string;
36 FMS: TMemoryStream;
37 begin
38 Result := False;
39 if FileExists(FFileName) then
40 try
41 FMS := TMemoryStream.Create;
42 FMS.LoadFromFile(FFileName);
43 with TIdHashMessageDigest5.Create do
44 try
45 FHashString := HashStreamAsHex(FMS);
46 finally
47 Free;
48 end;
49 if (FHashString = Lib7zHash) or (FHashString = PckRealHash)
50 or (FHashString = PckCodecHash) then Result := True;
51 finally
52 FreeAndNil(FMS);
53 end;
54 end;
55
56 end.
