diff --git a/ApplicationMain.dfm b/ApplicationMain.dfm index a31424f..ef361c8 100644 --- a/ApplicationMain.dfm +++ b/ApplicationMain.dfm @@ -1,12 +1,11 @@ object Form1: TForm1 - Left = 270 - Top = 15 + Left = 123 + Top = 125 AlphaBlendValue = 180 BorderStyle = bsNone ClientHeight = 80 ClientWidth = 444 - Color = clWhite - TransparentColor = True + Color = 962030 TransparentColorValue = clWhite DoubleBuffered = True Font.Charset = DEFAULT_CHARSET @@ -17,10 +16,16 @@ object Form1: TForm1 GlassFrame.SheetOfGlass = True Position = poDesigned Scaled = False - OnClose = FormClose + OnCreate = FormCreate OnDestroy = FormDestroy OnKeyDown = FormKeyDown OnMouseDown = FormMouseDown + OnPaint = FormPaint OnShow = FormShow TextHeight = 12 + object Timer1: TTimer + OnTimer = Timer1Timer + Left = 144 + Top = 24 + end end diff --git a/ApplicationMain.pas b/ApplicationMain.pas index 1bd6711..4310ba9 100644 --- a/ApplicationMain.pas +++ b/ApplicationMain.pas @@ -4,348 +4,452 @@ interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, - core, Dialogs, ExtCtrls, core_db, Generics.Collections, Vcl.Imaging.pngimage, - inifiles, Vcl.Imaging.jpeg, u_debug, ComObj, System.Math, ConfigurationForm, - Vcl.Menus, InfoBarForm, System.Generics.Collections, event; + core, Dialogs, ExtCtrls, Generics.Collections, Vcl.Imaging.pngimage, TlHelp32, + System.IOUtils, Winapi.ShellAPI, inifiles, Vcl.Imaging.jpeg, u_debug, ComObj, + PsAPI, Winapi.GDIPAPI, Winapi.GDIPOBJ, System.SyncObjs, System.Hash, + System.Math, System.JSON, u_json, ConfigurationForm, Vcl.Menus, Winapi.ActiveX, + InfoBarForm, System.Generics.Collections, event, Vcl.StdCtrls, + Vcl.VirtualImage; type TForm1 = class(TForm) + Timer1: TTimer; + procedure FormMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure FormShow(Sender: TObject); procedure FormDestroy(Sender: TObject); - procedure action_setClick(Sender: TObject); - procedure action_terminateClick(Sender: TObject); - procedure action_set_acceClick(Sender: TObject); - procedure action_bootom_panelClick(Sender: TObject); - procedure N1Click(Sender: TObject); - procedure FormClose(Sender: TObject; var Action: TCloseAction); + procedure action_config(Sender: TObject); + procedure action_terminate(Sender: TObject); + procedure action_set_acce(Sender: TObject); + procedure action_bootom_panel(Sender: TObject); + procedure action_translator(Sender: TObject); procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); + procedure Timer1Timer(Sender: TObject); + procedure FormCreate(Sender: TObject); + procedure FormPaint(Sender: TObject); private - FShowkeyid: Word; - procedure hotkey(var Msg: tmsg); message WM_HOTKEY; - procedure img_click(Sender: TObject); + node_at_cursor: t_node; + + gdraw_text: string; + procedure node_click(Sender: TObject); procedure wndproc(var Msg: tmessage); override; procedure snap_top_windows; - procedure CleanupPopupMenu; private - var - img_bg1: timage; - pm: TPopupMenu; - menuItems: array of TMenuItem; - procedure imgMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); - procedure CreateRoundRectRgn1(w, h: Integer); - procedure CalculateAndPositionNodes; + main_background: timage; + into_snap_windows: Boolean; + pm: TPopupMenu; + menuItems: array of TMenuItem; + procedure node_mouse_enter(Sender: TObject); + + procedure node_mouse_move(Sender: TObject; Shift: TShiftState; X, Y: Integer); + procedure node_mouse_leave(Sender: TObject); + procedure CalculateAndPositionNodes(); procedure img_bgMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure move_windows(h: thandle); - procedure imgMouseLeave(Sender: TObject); - procedure imgMouseWheel(Sender: TObject; Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean); - procedure loadInit; + procedure Initialize_form; + private + FAltF4Key, FShowkeyid: Word; + procedure hotkey(var Msg: tmsg); message WM_HOTKEY; + public + hoverLabel: TLabel; + procedure ConfigureLayout; + private + procedure handle_animation_tick(Sender: TObject; lp: TPoint); + function get_node_at_point(ScreenPoint: TPoint): t_node; + procedure form_mouse_wheel(WheelMsg: TWMMouseWheel); + procedure CleanupPopupMenu; + + procedure action_hide_task(Sender: TObject); + procedure FreeDictionary; + procedure action_hide_desk(Sender: TObject); + + end; + + TMyThread = class(TThread) + private + FOnUpdateUI: TThreadProcedure; + protected + procedure Execute; override; + procedure UpdateUI; public - procedure layout; + constructor Create(OnUpdateUI: TThreadProcedure); end; var Form1: TForm1; + tmp_json: TDictionary; + cs: TCriticalSection; implementation {$R *.dfm} -procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); -begin - if Key = VK_ESCAPE then - Close; -end; - // 处理定时器事件的函数 - -procedure TimerProc(hwnd: hwnd; uMsg, idEvent: UINT; dwTime: DWORD); stdcall; +procedure sort_layout(hwnd: hwnd; uMsg, idEvent: UINT; dwTime: DWORD); stdcall; begin Form1.snap_top_windows(); end; + + // 计算和定位节点的逻辑 procedure TForm1.CalculateAndPositionNodes(); +var + Node: t_node; + I: Integer; + v: TSettingItem; begin - var hashKeys1 := g_core.dbmgr.itemdb.GetKeys(); - g_core.nodes.size := hashKeys1.Count; - - if g_core.nodes.nodes_array <> nil then - begin - for var Node in g_core.nodes.nodes_array do - FreeAndNil(Node); - end; + cs.Enter; + try + g_core.nodes.count := g_core.json.Settings.Count; - Form1.height := g_core.nodes.node_size + g_core.nodes.node_size div 2 + 28; + if g_core.nodes.Nodes <> nil then + for Node in g_core.nodes.Nodes do + begin + g_core.json.Settings.TryGetValue(Node.key, v); + if not v.Is_path_valid then + FreeAndNil(v.memory_image); + FreeAndNil(Node); + end; - setlength(g_core.nodes.nodes_array, g_core.nodes.size); - for var I := 0 to g_core.nodes.size - 1 do - begin - g_core.nodes.nodes_array[I] := tnode.Create(self); - g_core.nodes.nodes_array[I].Width := g_core.nodes.node_size; - g_core.nodes.nodes_array[I].Height := g_core.nodes.node_size; + Form1.height := g_core.nodes.node_size + g_core.nodes.node_size div 2 + 100; - if I = 0 then - g_core.nodes.nodes_array[I].Left := g_core.nodes.node_gap + 16 - else + setlength(g_core.nodes.Nodes, g_core.nodes.count); + I := 0; + for var Key in g_core.json.Settings.keys do begin + var MValue := g_core.json.Settings.Items[Key]; + Node := t_node.Create(self); + g_core.nodes.Nodes[I] := Node; + Node.Width := g_core.nodes.node_size; + Node.Height := g_core.nodes.node_size; + + if I = 0 then + Node.Left := g_core.nodes.node_gap + exptend + else - g_core.nodes.nodes_array[I].Left := g_core.nodes.nodes_array[I - 1].Left + g_core.nodes.nodes_array[I - 1].Width + g_core.nodes.node_gap * 2 + 20; //10延展一下 g_core.nodes.node_gap + Node.Left := g_core.nodes.Nodes[I - 1].Left + g_core.nodes.node_gap + Node.Width; + with Node do + begin + id := I; + Top := (Self.ClientHeight - g_core.nodes.node_size) div 2; + Center := true; + + Transparent := true; + Parent := self; + file_path := MValue.FilePath; + tool_tip := MValue.tool_tip; + + if MValue.Is_path_valid then + Picture.LoadFromFile(ExtractFilePath(ParamStr(0)) + 'img\' + MValue.image_file_name) + else + begin + MValue.memory_image.Position := 0; + Picture.LoadFromStream(MValue.memory_image); + end; + + Stretch := true; + OnMouseLeave := node_mouse_leave; + OnMouseMove := node_mouse_move; + OnMouseDown := FormMouseDown; + OnClick := node_click; + + OnMouseEnter := node_mouse_enter; + + original_width := g_core.nodes.Nodes[I].Width; + original_height := g_core.nodes.Nodes[I].height; + center_x := g_core.nodes.Nodes[I].Left + g_core.nodes.Nodes[I].Width div 2; + center_y := g_core.nodes.Nodes[I].top + g_core.nodes.Nodes[I].height div 2; + + end; + Inc(I) end; - with g_core.nodes.nodes_array[I] do - begin + if g_core.nodes.count > 0 then + Self.Width := g_core.nodes.Nodes[g_core.nodes.count - 1].Left + g_core.nodes.Nodes[g_core.nodes.count - 1].Width + g_core.nodes.node_gap + exptend; - top := (self.GetClientRect().height - g_core.nodes.node_size) div 2; - Parent := Form1; - Width := g_core.nodes.node_size; - height := g_core.nodes.node_size; - Transparent := true; - Center := true; - node_path := g_core.dbmgr.itemdb.GetString(hashKeys1[I], False); - var t := g_core.dbmgr.itemdb.GetString(hashKeys1[I]); - - if t.Contains('.\img') then - Picture.LoadFromFile(ExtractFilePath(ParamStr(0)) + 'img\' + ExtractFileName(t)) - else + except - Picture.LoadFromFile(t); + end; + cs.Leave; +end; + +procedure TForm1.snap_top_windows(); +var + lp: tpoint; +begin - Stretch := true; + if g_core.nodes.is_configuring then + exit; - OnMouseMove := imgMouseMove; - OnMouseLeave := imgMouseLeave; - OnMouseDown := FormMouseDown; - OnClick := img_click; - OnMouseWheel := imgMouseWheel; + GetCursorPos(lp); + if not PtInRect(self.BoundsRect, lp) and not into_snap_windows then + begin + into_snap_windows := true; - node_left := g_core.nodes.nodes_array[I].Left; + CalculateAndPositionNodes(); - original_width := g_core.nodes.nodes_array[I].Width; - original_height := g_core.nodes.nodes_array[I].height; - center_x := g_core.nodes.nodes_array[I].Left + g_core.nodes.nodes_array[I].Width div 2; - center_y := g_core.nodes.nodes_array[I].top + g_core.nodes.nodes_array[I].height div 2; + Left := Screen.Width div 2 - Width div 2; + if top < top_snap_distance then + begin + top := -(height - visible_height) - 5; + Left := Screen.Width div 2 - Width div 2; + restore_state(); end; - end; + into_snap_windows := false; - Form1.Width := g_core.nodes.nodes_array[g_core.nodes.size - 1].Left + g_core.nodes.nodes_array[g_core.nodes.size - 1].Width + g_core.nodes.nodes_array[g_core.nodes.size - 1].Width div 2; // g_core.nodes.node_gap+20; + end + else if top < top_snap_distance then + top := 0; +end; - freeandnil(hashKeys1); +procedure TForm1.Timer1Timer(Sender: TObject); +var + differences: TStringList; + i: Integer; + pIco: TIcon; + bmpIco: TBitmap; + IconIndex: Word; + png: TPNGImage; + SettingItem: TSettingItem; + tmp_key: string; + SettingsObj: TJSONObject; + bcontinue: boolean; +begin + Timer1.Enabled := False; + TMyThread.Create( + procedure + begin + Timer1.Interval := 2000; + Timer1.Enabled := True; + end); end; -// 布局逻辑 -procedure TForm1.layout(); +procedure tform1.FreeDictionary; +var + Key: string; + SettingItem: TSettingItem; begin - g_core.nodes.Is_cfging := False; + for Key in tmp_json.Keys do + begin + SettingItem := tmp_json[Key]; + if not SettingItem.Is_path_valid and Assigned(SettingItem.memory_image) then + begin + SettingItem.memory_image.Free; + SettingItem.memory_image := nil; + end; + end; + tmp_json.Free; +end; - img_bg1.Parent := self; - img_bg1.Align := alClient; - img_bg1.Transparent := true; - img_bg1.Stretch := true; +procedure tform1.Initialize_form(); +var + menuItemClickHandlers: array[0..6] of t_menu_click_handler; +begin + Form1.Font.Name := Screen.Fonts.Text; + Form1.Font.Size := 9; - img_bg1.Picture.LoadFromFile(ExtractFilePath(ParamStr(0)) + 'img\bg.png'); + DoubleBuffered := True; + BorderStyle := bsNone; - img_bg1.OnMouseDown := img_bgMouseDown; + tmp_json := TDictionary.Create; + if main_background = nil then + main_background := timage.Create(self); + main_background.OnMouseDown := img_bgMouseDown; + main_background.Width := Width; + g_core.utils.init_background(main_background, self); - CalculateAndPositionNodes(); + cs := TCriticalSection.Create; + into_snap_windows := false; - var TotalMonitorWidth := 0; + form1.left := g_core.json.Config.Left; + Form1.top := g_core.json.Config.Top; - var PrimaryMonitorHeight := Screen.monitors[0].height; - case Screen.monitorcount of - 1: - TotalMonitorWidth := Screen.monitors[0].Width; + SetWindowLong(Handle, GWL_EXSTYLE, GetWindowLong(Handle, GWL_EXSTYLE) and (not WS_EX_APPWINDOW)); + SetWindowPos(Handle, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE or SWP_NOSIZE); + ShowWindow(Application.Handle, SW_HIDE); - // 2: - // TotalMonitorWidth := Screen.monitors[0].Width + Screen.monitors[1].Width; - else - TotalMonitorWidth := Screen.monitors[0].Width; + if pm = nil then + pm := TPopupMenu.Create(self); + menuItemClickHandlers[0] := action_translator; + menuItemClickHandlers[1] := action_bootom_panel; + menuItemClickHandlers[2] := action_config; + menuItemClickHandlers[3] := action_set_acce; + menuItemClickHandlers[4] := action_terminate; + menuItemClickHandlers[5] := action_hide_task; + menuItemClickHandlers[6] := action_hide_desk; + setlength(menuItems, Length(menu_labels)); + + for var I := 0 to High(menuItems) do + begin + menuItems[I] := TMenuItem.Create(self); + menuItems[I].Caption := menu_labels[I]; + menuItems[I].OnClick := menuItemClickHandlers[I]; + pm.Items.Add(menuItems[I]); end; - if Form1.Left > TotalMonitorWidth then - Form1.Left := Screen.monitors[0].Width div 4; - if Form1.top > PrimaryMonitorHeight then - Form1.top := 0; - - g_core.utils.short_key := g_core.dbmgr.cfgDb.GetString('shortcut'); + PopupMenu := pm; - restore_state(); - CreateRoundRectRgn1(Width, height); + exclusion_app := g_core.json.Exclusion.Value; - if Form1.Width > TotalMonitorWidth then + if FindAtom('ZWXhoaabbtKey') = 0 then begin - - g_core.nodes.node_size := g_core.dbmgr.cfgDb.GetInteger('ih'); - g_core.nodes.node_gap := Round(g_core.nodes.node_size div 4); - - CalculateAndPositionNodes(); - end - -end; - -procedure TForm1.img_click(Sender: TObject); -begin - g_core.utils.launch_app(tnode(Sender).node_path); - EventDef.isLeftClick := False; + FShowkeyid := GlobalAddAtom('ZWXhoaabbtKey'); + RegisterHotKey(Handle, FShowkeyid, MOD_CONTROL, $42); + end; end; -procedure TForm1.action_terminateClick(Sender: TObject); -begin - g_core.dbmgr.cfgDb.SetVarValue('left', Left); - g_core.dbmgr.cfgDb.SetVarValue('top', top); - Application.Terminate; -end; -procedure TForm1.wndproc(var Msg: tmessage); -begin - inherited; - case Msg.Msg of - WM_MOUSEMOVE, WM_MOUSEACTIVATE, WM_MOUSEHOVER: - begin - KillTimer(Handle, 10); - SetTimer(Handle, 10, 10, @TimerProc); - end; - WM_MOUSELEAVE: - begin - TThread.CreateAnonymousThread( - procedure - begin - Sleep(1000); - KillTimer(Handle, 10); - end).Start; - - end; - end; -end; +// 布局逻辑 -procedure TForm1.snap_top_windows(); +procedure TForm1.handle_animation_tick(Sender: TObject; lp: TPoint); var - lp: tpoint; - I: Integer; + NewFormWidth: Integer; + j: Integer; + Delta: Integer; + ExpDelta: Double; + rate: Double; begin - if g_core.nodes.Is_cfging then - exit; - GetCursorPos(lp); - if not PtInRect(self.BoundsRect, lp) then + NewFormWidth := g_core.nodes.Nodes[g_core.nodes.count - 1].Left + g_core.nodes.Nodes[g_core.nodes.count - 1].Width + g_core.nodes.node_gap + exptend; + // 计算移动的增量 + Delta := NewFormWidth - Width; + + if node_at_cursor <> nil then begin - for I := 0 to g_core.nodes.size - 1 do - begin + rate := 1; - g_core.nodes.nodes_array[I].SetBounds(g_core.nodes.nodes_array[I].center_x - g_core.nodes.nodes_array[I].original_width div 2, g_core.nodes.nodes_array[I].center_y - g_core.nodes.nodes_array[I].original_height div 2, g_core.nodes.nodes_array[I].original_width, g_core.nodes.nodes_array[I].original_height); + ExpDelta := Delta * rate; - end; + SetBounds(Left - Round(ExpDelta) div 2, Top, Width + Round(ExpDelta), Height); - if top < top_snap_distance then + for j := 0 to g_core.nodes.count - 1 do begin - top := -(height - visible_height) - 5; - Left := Screen.Width div 2 - Width div 2; - restore_state(); - end + var inner_node := g_core.nodes.Nodes[j]; + if j = 0 then + inner_node.Left := g_core.nodes.node_gap + exptend + else + inner_node.Left := g_core.nodes.Nodes[j - 1].Left + g_core.nodes.Nodes[j - 1].Width + g_core.nodes.node_gap; + end; + + end; - end - else if top < top_snap_distance then - top := 0; end; -procedure TForm1.CreateRoundRectRgn1(w, h: Integer); -var - Rgn: HRGN; +procedure TForm1.hotkey(var Msg: tmsg); begin - Rgn := CreateRoundRectRgn(0, 0, w, h, 8, 8); + if (Msg.message = FShowkeyid) then + begin + + var v := get_json_value('config', 'shortcut'); - SetWindowRgn(Handle, Rgn, true); + ShellExecute(0, 'open', PChar(v), nil, nil, SW_SHOW); + end; end; -procedure tform1.loadInit(); +procedure TForm1.node_mouse_enter(Sender: TObject); var - I: Integer; - menuItemClickHandlers: array[0..4] of TMenuClickHandler; + Node: t_node; begin - if img_bg1 = nil then - img_bg1 := timage.Create(nil); - if not TOSVersion.Check(6, 2) then - Application.Terminate; - - Form1.Left := g_core.dbmgr.cfgDb.GetInteger('left'); - Form1.top := g_core.dbmgr.cfgDb.GetInteger('top'); - - SetWindowLong(Handle, GWL_EXSTYLE, GetWindowLong(Handle, GWL_EXSTYLE) and (not WS_EX_APPWINDOW)); - ShowWindow(Application.Handle, SW_HIDE); - SetWindowPos(Handle, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE or SWP_NOSIZE); + Node := Sender as t_node; - if FindAtom('xxyyzz_hotkey') = 0 then + if not Assigned(hoverLabel) then begin - FShowkeyid := GlobalAddAtom('xxyyzz_hotkey'); - RegisterHotKey(Handle, FShowkeyid, MOD_CONTROL, $42); + hoverLabel := TLabel.Create(Self); + hoverLabel.Parent := Parent; + hoverLabel.Transparent := True; + hoverLabel.Caption := Node.tool_tip; + gdraw_text := Node.tool_tip; + hoverLabel.Font.Size := 14; + hoverLabel.Font.Color := clBlack; end; - killtimer(Handle, 10); - SetTimer(Handle, 10, 10, @TimerProc); - - layout(); - - BorderStyle := bsNone; - CreateRoundRectRgn1(Width + 1, height + 1); + hoverLabel.Left := Node.Left + (Node.Width div 2) - (hoverLabel.Width div 2); + hoverLabel.Top := Node.Top - hoverLabel.Height - 5; + hoverLabel.Visible := True; - if pm = nil then - pm := TPopupMenu.Create(self); - menuItemClickHandlers[0] := N1Click; - menuItemClickHandlers[1] := action_bootom_panelClick; - menuItemClickHandlers[2] := action_setClick; - menuItemClickHandlers[3] := action_set_acceClick; - menuItemClickHandlers[4] := action_terminateClick; +end; - setlength(menuItems, Length(menu_name)); +procedure TForm1.node_mouse_leave(Sender: TObject); +begin + hoverLabel.Visible := false; + if hoverLabel <> nil then + FreeAndNil(hoverLabel) +end; - for I := 0 to High(menuItems) do - begin - menuItems[I] := TMenuItem.Create(self); - menuItems[I].Caption := menu_name[I]; - menuItems[I].OnClick := menuItemClickHandlers[I]; - pm.Items.Add(menuItems[I]); +procedure TForm1.wndproc(var Msg: tmessage); +begin + inherited; + case Msg.Msg of + WM_MOUSEWHEEL: + form_mouse_wheel(TWMMouseWheel(Msg)); end; - - PopupMenu := pm; - form1.OnMouseWheel := imgMouseWheel; - end; procedure TForm1.FormShow(Sender: TObject); begin - loadInit(); -end; -procedure TForm1.hotkey(var Msg: tmsg); -begin - if (Msg.message = FShowkeyid) and (g_core.utils.short_key.Trim <> '') then - g_core.utils.launch_app(g_core.utils.short_key); + Initialize_form(); + + ConfigureLayout(); + SetTimer(Handle, 10, 10, @sort_layout); + +// action_bootom_panel(Self); + + add_json('startx', 'Start Button.png', 'startx', '开始菜单', True, nil); + add_json('recycle', 'recycle.png', 'recycle', '回收站', True, nil); + + if bottomForm = nil then + bottomForm := TbottomForm.Create(self); + + bottomForm.show; + bottomForm.top := 0; + bottomForm.Left := (Screen.WorkAreaWidth - bottomForm.Width) div 2; end; -// 处理鼠标离开事件 -procedure TForm1.imgMouseLeave(Sender: TObject); +function TForm1.get_node_at_point(ScreenPoint: TPoint): t_node; +var + ClientPoint: TPoint; + I: Integer; + Node: t_node; begin + Result := nil; + ClientPoint := ScreenToClient(ScreenPoint); + + for I := 0 to g_core.nodes.count - 1 do + begin + Node := g_core.nodes.Nodes[I]; + + if PtInRect(Node.BoundsRect, ClientPoint) then + begin + Result := Node; + Exit; + end; + end; end; + // 移动窗口逻辑 -procedure TForm1.imgMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); + +procedure TForm1.node_mouse_move(Sender: TObject; Shift: TShiftState; X, Y: Integer); var - a, rate: double; - b: double; + rate: double; + a, b: integer; I: Integer; -var - Distance, ZoomFactor: double; - NewWidth, NewHeight, NewLeft, NewTop: Integer; + NewWidth, NewHeight: Integer; + Current_node: t_node; + lp: tpoint; begin - if g_core.nodes.Is_cfging then + if g_core.nodes.is_configuring then exit; + if (EventDef.isLeftClick) then begin if (X <> EventDef.X) or (Y <> EventDef.Y) then @@ -359,87 +463,178 @@ procedure TForm1.imgMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer end else begin - var lp: tpoint; + + var Node := t_node(Sender); + if hoverLabel <> nil then + begin + hoverLabel.Left := Node.Left + (Node.Width div 2) - (hoverLabel.Width div 2); + hoverLabel.Top := Node.Top - hoverLabel.Height - 5; + end; + GetCursorPos(lp); - for I := 0 to g_core.nodes.size - 1 do + + node_at_cursor := get_node_at_point(lp); + + for I := 0 to g_core.nodes.count - 1 do begin - a := g_core.nodes.nodes_array[I].Left - ScreenToClient(lp).X + g_core.nodes.nodes_array[I].Width / 2; - b := g_core.nodes.nodes_array[I].top - ScreenToClient(lp).Y + g_core.nodes.nodes_array[I].height / 4; - rate := Exp(-sqrt(a * a + b * b) / (103.82 * 5)); + Current_node := g_core.nodes.Nodes[I]; + + a := Current_node.Left - ScreenToClient(lp).X + Current_node.Width div 2; + b := Current_node.Top - ScreenToClient(lp).Y + Current_node.Height div 4; + + rate := g_core.utils.rate(a, b); rate := Min(Max(rate, 0.5), 1); - NewWidth := Round(g_core.nodes.nodes_array[I].original_width * 2 * rate); - NewHeight := Round(g_core.nodes.nodes_array[I].original_height * 2 * rate); + NewWidth := Round(Current_node.original_width * 2 * rate); + NewHeight := Round(Current_node.original_height * 2 * rate); var maxValue: Integer := 128; - // 限制按钮的最大宽度和高度 + NewWidth := Min(NewWidth, maxValue); NewHeight := Min(NewHeight, maxValue); - // 计算按钮的新位置，使其保持在中心点 - + Current_node.center_x := Current_node.Left + Current_node.Width div 2; + Current_node.center_y := Current_node.Top + Current_node.Height div 2; - g_core.nodes.nodes_array[I].center_x := g_core.nodes.nodes_array[I].Left + g_core.nodes.nodes_array[I].Width div 2; - g_core.nodes.nodes_array[I].center_y := g_core.nodes.nodes_array[I].Top + g_core.nodes.nodes_array[I].Height div 2; - g_core.nodes.nodes_array[I].SetBounds(g_core.nodes.nodes_array[I].center_x - NewWidth div 2, g_core.nodes.nodes_array[I].center_y - NewHeight div 2, NewWidth, NewHeight); + Current_node.SetBounds(Current_node.center_x - NewWidth div 2, Current_node.center_y - NewHeight div 2, NewWidth, NewHeight); end; + handle_animation_tick(Self, lp); + end; end; -procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction); +procedure TForm1.FormCreate(Sender: TObject); begin - CleanupPopupMenu(); + + SetWindowLong(Handle, GWL_EXSTYLE, GetWindowLong(Handle, GWL_EXSTYLE) or WS_EX_LAYERED); + + SetLayeredWindowAttributes(Handle, $000EADEE, 0, LWA_COLORKEY); +end; + +procedure TForm1.CleanupPopupMenu; +var + menuItem: TMenuItem; +begin + for menuItem in menuItems do + menuItem.Free; + pm.Free; end; procedure TForm1.FormDestroy(Sender: TObject); +var + v: TSettingItem; + SettingsObj: TJSONObject; begin - UnregisterHotKey(Handle, FShowkeyid); - GlobalDeleteAtom(FShowkeyid); + SettingsObj := g_jsonobj.GetValue('settings') as TJSONObject; + if SettingsObj = nil then + Exit; + + for var KeyValuePair in g_core.json.Settings do + begin + if (SettingsObj.GetValue(KeyValuePair.key) = nil) then + begin + if (KeyValuePair.Value.Is_path_valid) then + add_or_update(SettingsObj, KeyValuePair.key, KeyValuePair.Value.image_file_name, KeyValuePair.Value.FilePath, KeyValuePair.Value.tool_tip); + end; + + end; + + if g_core.nodes.Nodes <> nil then + for var Node in g_core.nodes.Nodes do + begin + + FreeAndNil(Node); + end; + + try + SaveJSONToFile(ExtractFilePath(ParamStr(0)) + 'cfg.json', g_jsonobj); + except + on E: Exception do + begin + ShowMessage('Error saving JSON file: ' + E.Message); + end; + end; + + CleanupPopupMenu(); + FreeDictionary(); + + cs.Free; KillTimer(Handle, 10); - action_terminateClick(self); - img_bg1.Free; + action_terminate(self); + main_background.Free; + end; procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin - if g_core.nodes.Is_cfging then + if g_core.nodes.is_configuring then exit; - - EventDef.isLeftClick := true; - EventDef.Y := Y; - EventDef.X := X; + if Button = mbleft then + begin + EventDef.isLeftClick := true; + EventDef.Y := Y; + EventDef.X := X; + end; end; -procedure TForm1.imgMouseWheel(Sender: TObject; Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean); +procedure TForm1.FormPaint(Sender: TObject); var - I: Integer; - NewWidth, NewHeight: Integer; + g: TGPGraphics; + font: TGPFont; begin - if g_core.nodes.Is_cfging then - Exit; + if Assigned(hoverLabel) then + begin - Handled := True; + g := TGPGraphics.Create(Canvas.Handle); + try + var sbRed := TGPSolidBrush.Create(aclWhite); + var sbBlack := TGPSolidBrush.Create(aclBlack); + font := TGPFont.Create('微软雅黑', 16, FontStyleRegular); + try + g.DrawString(gdraw_text, -1, font, MakePoint(hoverLabel.Left - 1, hoverLabel.top + 0.0), sbBlack); + g.DrawString(gdraw_text, -1, font, MakePoint(hoverLabel.Left + 1, hoverLabel.top + 0.0), sbBlack); + g.DrawString(gdraw_text, -1, font, MakePoint(hoverLabel.Left, hoverLabel.top + 0.0 - 1), sbBlack); + g.DrawString(gdraw_text, -1, font, MakePoint(hoverLabel.Left, hoverLabel.top + 0.0 + 1), sbBlack); + + g.DrawString(gdraw_text, -1, font, MakePoint(hoverLabel.Left, hoverLabel.top + 0.0), sbRed); + finally + font.Free; + sbRed.Free; + sbBlack.Free; + end; + finally + g.Free; + end; + end; + +end; + +procedure TForm1.form_mouse_wheel(WheelMsg: TWMMouseWheel); +begin + if g_core.nodes.is_configuring then + Exit; // 根据滚轮方向调整节点大小 - if WheelDelta > 0 then + if WheelMsg.WheelDelta > 0 then begin - var i1 := g_core.dbmgr.cfgDb.GetInteger('ih'); + + var i1 := g_core.json.Config.nodesize; i1 := round(1.1 * i1); g_core.nodes.node_size := i1; - g_core.dbmgr.cfgDb.SetVarValue('ih', i1); + set_nodesize_value(g_core.json, i1); end else begin - var i1 := g_core.dbmgr.cfgDb.GetInteger('ih'); + var i1 := g_core.json.Config.nodesize; i1 := round(i1 * 0.9); g_core.nodes.node_size := i1; - g_core.dbmgr.cfgDb.SetVarValue('ih', i1); + set_nodesize_value(g_core.json, i1); end; - layout(); + ConfigureLayout(); end; @@ -458,23 +653,25 @@ procedure TForm1.move_windows(h: thandle); end; -procedure TForm1.N1Click(Sender: TObject); +procedure TForm1.action_translator(Sender: TObject); begin - g_core.utils.launch_app('https://fanyi.baidu.com/'); + g_core.utils.launch_app(g_core.json.Config.translator); end; -procedure TForm1.action_setClick(Sender: TObject); +procedure TForm1.action_config(Sender: TObject); var vobj: TObject; begin - vobj := g_core.FindObjectByName('cfgForm'); - TCfgForm(vobj).Show; - - g_core.nodes.Is_cfging := true; + Timer1.Enabled := false; + vobj := g_core.find_object_by_name('cfgForm'); + g_core.nodes.is_configuring := true; SetWindowPos(TCfgForm(vobj).Handle, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE or SWP_NOSIZE); + TCfgForm(vobj).ShowModal; + + Timer1.Enabled := true; end; -procedure TForm1.action_set_acceClick(Sender: TObject); +procedure TForm1.action_set_acce(Sender: TObject); var OpenDlg: TOpenDialog; begin @@ -486,36 +683,272 @@ procedure TForm1.action_set_acceClick(Sender: TObject); if Execute then begin - g_core.utils.short_key := filename; - g_core.dbmgr.cfgDb.SetVarValue('shortcut', g_core.utils.short_key.Trim); + + cs.Enter; + + set_json_value('config', 'shortcut', FileName); + + cs.Leave; end; end; OpenDlg.Free; end; -procedure TForm1.action_bootom_panelClick(Sender: TObject); -var - vobj: TObject; +procedure TForm1.action_bootom_panel(Sender: TObject); begin +// if bottomForm = nil then +// bottomForm := TbottomForm.Create(self); +// +// bottomForm.show; +// bottomForm.top := 0; +// bottomForm.Left := (Screen.WorkAreaWidth - bottomForm.Width) div 2; - vobj := g_core.FindObjectByName('bottomForm'); - TbottomForm(vobj).Show; - TbottomForm(vobj).top := Screen.WorkAreaHeight - TbottomForm(vobj).height; - TbottomForm(vobj).Width := Screen.WorkAreaWidth - 10; - TbottomForm(vobj).Left := ((Screen.WorkAreaWidth - TbottomForm(vobj).Width) div 2); + if TMenuItem(Sender).Checked then + begin + TMenuItem(Sender).Checked := false; + if bottomForm = nil then + bottomForm := TbottomForm.Create(self); + + bottomForm.Visible := true; + bottomForm.top := 0; + bottomForm.Left := (Screen.WorkAreaWidth - bottomForm.Width) div 2; + end + else + begin + TMenuItem(Sender).Checked := true; + if bottomForm = nil then + bottomForm := TbottomForm.Create(self); + + bottomForm.Visible := false; + bottomForm.top := 0; + bottomForm.Left := (Screen.WorkAreaWidth - bottomForm.Width) div 2; + end; restore_state(); end; -procedure TForm1.CleanupPopupMenu; +procedure TForm1.action_hide_task(Sender: TObject); +begin + if TMenuItem(Sender).Checked then + begin + TMenuItem(Sender).Checked := false; + g_core.utils.SetTaskbarAutoHide(false); + end + else + begin + TMenuItem(Sender).Checked := true; + g_core.utils.SetTaskbarAutoHide(true); + end; + +end; + +procedure TForm1.action_hide_desk(Sender: TObject); +begin + if TMenuItem(Sender).Checked then + begin + TMenuItem(Sender).Checked := false; + ShowDesktopIcons(); + end + else + begin + TMenuItem(Sender).Checked := true; + HideDesktopIcons() + end; + +end; + +procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); +begin + if Key = VK_ESCAPE then + Close; +end; + +procedure TForm1.ConfigureLayout(); +begin + g_core.nodes.is_configuring := False; + + CalculateAndPositionNodes(); + var PrimaryMonitorHeight := Screen.monitors[0].height; + + if Form1.top > PrimaryMonitorHeight then + Form1.top := 0; + + restore_state(); + +end; + +procedure TForm1.node_click(Sender: TObject); +begin + if t_node(Sender).file_path = '' then + Exit; + if t_node(Sender).tool_tip = '开始菜单' then + begin + SimulateCtrlEsc(); + end + else if t_node(Sender).tool_tip = '回收站' then + begin + + if MessageDlg('Are you sure you want to empty the Recycle Bin?', mtConfirmation, [mbYes, mbNo], 0) = mrYes then + begin + EmptyRecycleBin(); + MessageDlg('The Recycle Bin has been emptied.', mtInformation, [mbOK], 0); + end; + end + else if t_node(Sender).tool_tip = '' then + g_core.utils.launch_app(t_node(Sender).file_path) + else if not BringWindowToFront(t_node(Sender).tool_tip) then + g_core.utils.launch_app(t_node(Sender).file_path); + + EventDef.isLeftClick := False; + +end; + +procedure TForm1.action_terminate(Sender: TObject); +begin + + set_json_value('config', 'left', left.ToString); + set_json_value('config', 'top', top.ToString); + Application.Terminate; +end; + +{ TMyThread } + +constructor TMyThread.Create(OnUpdateUI: TThreadProcedure); +begin + inherited Create(True); // Create suspended + FreeOnTerminate := True; + FOnUpdateUI := OnUpdateUI; + Resume; // Start the thread +end; + +procedure TMyThread.Execute; var - menuItem: TMenuItem; + differences: TStringList; + i: Integer; + pIco: TIcon; + bmpIco: TBitmap; + IconIndex: Word; + png: TPNGImage; + SettingItem: TSettingItem; + tmp_key: string; + SettingsObj: TJSONObject; + bcontinue: Boolean; begin - for menuItem in menuItems do - menuItem.Free; - pm.Free; + bcontinue := False; + try + differences := TStringList.Create; + try + // This method should not directly interact with the UI + GetRunningApplications(differences); + + cs.Enter; + try + tmp_json.Clear; + for i := 0 to differences.Count - 1 do + begin + var arr := differences[i].Split([',']); + IconIndex := 0; + + if g_core.json.Config.debug = 'true' then + Debug.Show(ExtractFileName(arr[0]) + '----' + arr[1]); + + if exclusion_app.Contains(ExtractFileName(arr[0])) then + Continue; + + for var Key in g_core.json.Settings.Keys do + begin + var Value := g_core.json.Settings.Items[Key]; + if Value.Is_path_valid and (Value.FilePath = arr[0]) then + begin + bcontinue := True; + Break; + end; + end; + + if bcontinue then + begin + bcontinue := False; + Continue; + end; + + tmp_key := THashMD5.GetHashString(ExtractFileName(arr[0])); + + if tmp_json.ContainsKey(tmp_key) then + Continue; + + var up := ChangeFileExt(ExtractFileName(arr[0]), '').ToUpper; + var img_path := get_json_value('icons', up); + + if img_path = '' then + begin + pIco := TIcon.Create; + try + pIco.Handle := ExtractAssociatedIcon(Application.Handle, PChar(arr[0]), IconIndex); + if pIco.Handle > 0 then + begin + bmpIco := TBitmap.Create; + try + bmpIco.PixelFormat := pf32bit; + bmpIco.Height := pIco.Height; + bmpIco.Width := pIco.Width; + bmpIco.Canvas.Draw(0, 0, pIco); + + SettingItem.memory_image := TMemoryStream.Create; + try + png := BmpToPngObj(bmpIco); + png.SaveToStream(SettingItem.memory_image); + + SettingItem.Is_path_valid := False; + SettingItem.FilePath := arr[0]; + SettingItem.tool_tip := arr[1]; + + tmp_json.AddOrSetValue(tmp_key, SettingItem); + except + SettingItem.memory_image.Free; + raise; // Re-raise the exception after cleaning up + end; + finally + bmpIco.Free; + png.Free; + end; + end; + finally + pIco.Free; + end; + end + else + begin + SettingItem.memory_image := TMemoryStream.Create; + SettingItem.memory_image.LoadFromFile(app_path + 'img\tmp\' + img_path); + SettingItem.Is_path_valid := False; + SettingItem.FilePath := arr[0]; + SettingItem.tool_tip := arr[1]; + + tmp_json.AddOrSetValue(tmp_key, SettingItem); + end; + end; + + UpdateCoreSettingsFromTmpJson(tmp_json, g_core.json.Settings, cs); + finally + cs.Leave; + end; + finally + differences.Free; + end; + except + // Handle exceptions here if needed + end; + + // Update the UI, if necessary + Synchronize(UpdateUI); +end; + +procedure TMyThread.UpdateUI; +begin + if Assigned(FOnUpdateUI) then + FOnUpdateUI(); end; end. diff --git a/ConfigurationForm.dfm b/ConfigurationForm.dfm index 32723bf..10ad250 100644 --- a/ConfigurationForm.dfm +++ b/ConfigurationForm.dfm @@ -14,20 +14,6 @@ object CfgForm: TCfgForm OnClose = FormClose OnShow = FormShow TextHeight = 14 - object Label1: TLabel - Left = 440 - Top = 328 - Width = 42 - Height = 14 - Caption = 'Label1' - end - object Label2: TLabel - Left = 204 - Top = 554 - Width = 84 - Height = 14 - Caption = #32972#26223#28176#21464#39068#33394 - end object ve1: TValueListEditor Left = 0 Top = 0 @@ -74,21 +60,22 @@ object CfgForm: TCfgForm Font.Style = [] ParentFont = False TabOrder = 1 - OnClick = Button1Click + OnClick = Buttoaction_translator end object imgEdit1: TLabeledEdit Left = 81 Top = 520 Width = 541 - Height = 22 + Height = 30 Hint = #21452#20987#28155#21152 + BorderStyle = bsNone EditLabel.Width = 70 - EditLabel.Height = 22 + EditLabel.Height = 30 EditLabel.Caption = #33258#23450#20041#22270#29255 Enabled = False Font.Charset = GB2312_CHARSET Font.Color = clWindowText - Font.Height = -14 + Font.Height = 30 Font.Name = #23435#20307 Font.Style = [] LabelPosition = lpLeft @@ -100,17 +87,18 @@ object CfgForm: TCfgForm OnDblClick = imgEdit1DblClick end object LabeledEdit2: TLabeledEdit - Left = 72 - Top = 602 - Width = 560 - Height = 22 + Left = 81 + Top = 584 + Width = 541 + Height = 30 Hint = #21452#20987#28155#21152 + BorderStyle = bsNone EditLabel.Width = 56 - EditLabel.Height = 22 + EditLabel.Height = 30 EditLabel.Caption = #25991#20214#36335#24452 Font.Charset = GB2312_CHARSET Font.Color = clWindowText - Font.Height = -14 + Font.Height = 30 Font.Name = #23435#20307 Font.Style = [] LabelPosition = lpLeft @@ -121,18 +109,19 @@ object CfgForm: TCfgForm Text = '' OnDblClick = LabeledEdit2DblClick end - object LabeledEdit3: TLabeledEdit - Left = 73 - Top = 553 + object text_edit: TLabeledEdit + Left = 81 + Top = 552 Width = 112 - Height = 22 + Height = 30 Hint = #21452#20987#28155#21152 - EditLabel.Width = 56 - EditLabel.Height = 22 - EditLabel.Caption = #25551#36848#25991#23383 + BorderStyle = bsNone + EditLabel.Width = 70 + EditLabel.Height = 30 + EditLabel.Caption = #33258#23450#20041#25991#23383 Font.Charset = GB2312_CHARSET Font.Color = clWindowText - Font.Height = -14 + Font.Height = 30 Font.Name = #23435#20307 Font.Style = [] LabelPosition = lpLeft @@ -146,7 +135,7 @@ object CfgForm: TCfgForm end object RadioGroup1: TRadioGroup Left = 649 - Top = 529 + Top = 520 Width = 112 Height = 70 TabOrder = 5 @@ -165,38 +154,29 @@ object CfgForm: TCfgForm Top = 568 Width = 97 Height = 17 - Caption = #25551#36848#25991#23383 + Caption = #33258#23450#20041#25991#23383 Checked = True TabOrder = 7 TabStop = True OnClick = rbtxtClick end - object ColorGrid1: TColorGrid - Left = 294 - Top = 545 - Width = 144 - Height = 52 - Ctl3D = False - ParentCtl3D = False + object tip: TLabeledEdit + Left = 416 + Top = 552 + Width = 206 + Height = 30 + BorderStyle = bsNone + EditLabel.Width = 126 + EditLabel.Height = 30 + EditLabel.Caption = #33258#23450#20041#22270#29255#25552#31034#20449#24687 + Font.Charset = GB2312_CHARSET + Font.Color = clWindowText + Font.Height = 30 + Font.Name = #23435#20307 + Font.Style = [] + LabelPosition = lpLeft + ParentFont = False TabOrder = 8 - OnChange = ColorGrid1Change - end - object ColorGrid2: TColorGrid - Left = 462 - Top = 545 - Width = 144 - Height = 52 - Ctl3D = False - ParentCtl3D = False - TabOrder = 9 - OnChange = ColorGrid2Change - end - object CheckBox1: TCheckBox - Left = 73 - Top = 579 - Width = 97 - Height = 17 - Caption = #25991#23383#39640#20142 - TabOrder = 10 + Text = #26080 end end diff --git a/ConfigurationForm.pas b/ConfigurationForm.pas index 2833e32..47901e2 100644 --- a/ConfigurationForm.pas +++ b/ConfigurationForm.pas @@ -6,8 +6,9 @@ interface Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Math, System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ComCtrls, Vcl.Grids, Vcl.ValEdit, Vcl.StdCtrls, Vcl.ExtCtrls, Vcl.Buttons, - u_debug, Vcl.Imaging.pngimage, System.Generics.Collections, Vcl.Menus, - Vcl.Mask, System.Hash, Vcl.Samples.Spin, Vcl.ColorGrd; + u_json, System.IniFiles, u_debug, Vcl.Imaging.pngimage, + System.Generics.Collections, Vcl.Menus, Vcl.Mask, System.Hash, + Vcl.Samples.Spin, Vcl.ColorGrd; type TCfgForm = class(TForm) @@ -15,16 +16,12 @@ TCfgForm = class(TForm) Button1: TButton; imgEdit1: TLabeledEdit; LabeledEdit2: TLabeledEdit; - LabeledEdit3: TLabeledEdit; + text_edit: TLabeledEdit; RadioGroup1: TRadioGroup; rbimg: TRadioButton; rbtxt: TRadioButton; - Label1: TLabel; - Label2: TLabel; - ColorGrid1: TColorGrid; - ColorGrid2: TColorGrid; - CheckBox1: TCheckBox; - procedure Button1Click(Sender: TObject); + tip: TLabeledEdit; + procedure Buttoaction_translator(Sender: TObject); procedure FormClose(Sender: TObject; var Action: TCloseAction); procedure FormShow(Sender: TObject); procedure imgEdit1DblClick(Sender: TObject); @@ -32,18 +29,15 @@ TCfgForm = class(TForm) procedure ve1DblClick(Sender: TObject); procedure rbtxtClick(Sender: TObject); procedure rbimgClick(Sender: TObject); - procedure ColorGrid1Change(Sender: TObject); - procedure ColorGrid2Change(Sender: TObject); private - procedure update_db; + file_map: TDictionary; + public end; var - OldNum: Integer = 0; - OldValue: Integer = 0; xchange: Boolean = false; - line_bg1,line_bg2:tcolor; + implementation {$R *.dfm} @@ -51,133 +45,160 @@ implementation uses ApplicationMain, core, GDIPAPI, GDIPOBJ, System.UITypes; -function text_outa(txt: string; y, gc1, gc2: TColor;light:boolean): string; +function GenerateTextImage(txt: string; y: Integer): string; var vPng: TPngImage; - aclStartColor, aclEndColor: TAlphaColor; font: TGPFont; sf: TGPStringFormat; - b2: TGPLinearGradientBrush; + whiteBrush: TGPSolidBrush; Graphics: TGPGraphics; + textLength: Integer; + middleX, middleY: Single; begin vPng := TPngImage.Create; - vPng.LoadFromFile(ExtractFilePath(ParamStr(0)) + 'img\template.png'); - - Graphics := TGPGraphics.Create(vPng.Canvas.Handle); - Graphics.SetSmoothingMode(SmoothingModeHighQuality); - graphics.SetInterpolationMode(InterpolationModeHighQualityBicubic);//指定的高品质，双三次插值 - Graphics.TranslateTransform(0, 0); - sf := TGPStringFormat.Create(); - - aclStartColor := TAlphaColorF.Create(GetRValue(gc1), GetGValue(gc1), GetBValue(gc1)).ToAlphaColor; - - aclEndColor := TAlphaColorF.Create(GetRValue(gc2), GetGValue(gc2), GetBValue(gc2)).ToAlphaColor; - -// b2 := TGPLinearGradientBrush.Create(MakePoint(0, 0), MakePoint(vPng.Width, vPng.Height), MakeColor(255,255,255,255), MakeColor(255,30,120,195)); - b2 := TGPLinearGradientBrush.Create(MakePoint(0, 0), MakePoint(vPng.Width, vPng.Height), aclStartColor, aclEndColor); - - Graphics.FillRectangle(b2, 0, 0, vPng.Width, vPng.Height); - - var b3 := TGPLinearGradientBrush.Create(MakePoint(0, 0), MakePoint(vPng.Width, vPng.Height), MakeColor(255,255,255,255), MakeColor(15,1,1,1)); - if light then - - b3 := TGPLinearGradientBrush.Create(MakePoint(0, 0), MakePoint(vPng.Width, vPng.Height), MakeColor(255,255,255,255), MakeColor(255,30,120,195)); - - - font := TGPFont.Create('黑体', 40); - Graphics.DrawString(txt, -1, font, MakePoint(0, y * 0.6), sf, b3); - Graphics.DrawString(txt, -1, font, MakePoint(1, y * 0.65), sf, b3); - - -// var fontFamily := TGPFontFamily.Create('黑体'); //△字体，效果图为'微软雅黑'字体 -//var strFormat := TGPStringFormat.Create(); -// var path := TGPGraphicsPath.Create(); -// //---------------------结束：初始化操作-------------------------------------- -// path.AddString('你好', -1, //要添加的 String -// fontFamily, //表示绘制文本所用字体的名称 -// 0, //指定应用到文本的字形信息,这里为普通文本 -// 40, //限定字符的 Em（字体大小）方框的高度 -// MakePoint(0, y * 0.65), //一个 Point，它表示文本从其起始的点 -// sf); //指定文本格式设置信息 -// var pen := TGPPen.Create(MakeColor(155,215,215,215),3); //颜色、宽度 -// graphics.DrawPath(pen,path); //初步绘制GraphicsPath - + try + vPng.LoadFromFile(ExtractFilePath(ParamStr(0)) + 'img\template.png'); + + Graphics := TGPGraphics.Create(vPng.Canvas.Handle); + try + Graphics.SetSmoothingMode(SmoothingModeHighQuality); + Graphics.SetInterpolationMode(InterpolationModeHighQualityBicubic); + Graphics.TranslateTransform(0, 0); + sf := TGPStringFormat.Create(); + + try + Graphics.Clear(TAlphaColorRec.Black); + + whiteBrush := TGPSolidBrush.Create(MakeColor(255, 245, 245, 245)); // White + + try + font := TGPFont.Create('黑体', 35); + + try + textLength := Length(txt); + middleX := vPng.Width / 2; + middleY := y; + + case textLength of + 4: + begin + + Graphics.DrawString(txt[2] + txt[3], -1, font, MakePoint(0, middleY * 0.6), sf, whiteBrush); + + Graphics.DrawString(txt[1], 1, font, MakePoint(middleX - 40, middleY - 60), sf, whiteBrush); + + Graphics.DrawString(txt[4], 1, font, MakePoint(middleX - 40, middleY + 20), sf, whiteBrush); + end; + 3: + begin + Graphics.DrawString(txt[2], 1, font, MakePoint(middleX - 20, middleY), sf, whiteBrush); + Graphics.DrawString(txt[3], 1, font, MakePoint(middleX + 20, middleY), sf, whiteBrush); + + Graphics.DrawString(txt[1], 1, font, MakePoint(middleX - 40, middleY - 40), sf, whiteBrush); + end; + 2: + begin + + Graphics.DrawString(txt, -1, font, MakePoint(0, middleY * 0.6), sf, whiteBrush); + end; + 1: + begin + var font1 := TGPFont.Create('黑体', 40); + Graphics.DrawString(txt, -1, font1, MakePoint(middleX - 40, y * 0.65), sf, whiteBrush); + Graphics.DrawString(txt, 1, font1, MakePoint(middleX - 40, middleY * 0.6), sf, whiteBrush); + font1.Free; + end + else + begin + var font1 := TGPFont.Create('黑体', 20); + Graphics.DrawString(txt, -1, font1, MakePoint(0, y * 0.6), sf, whiteBrush); + Graphics.DrawString(txt, -1, font1, MakePoint(1, y * 0.65), sf, whiteBrush); + font1.Free; + end; + end; + + Result := ExtractFilePath(ParamStr(0)) + 'img\' + FormatDateTime('yyyymmddhhnnsszzz', Now) + '.png'; + vPng.SaveToFile(Result); + + finally + font.Free; + end; + finally + whiteBrush.Free; + end; + finally + sf.Free; + end; - Result:=ExtractFilePath(ParamStr(0)) +'\img\' + FormatDateTime('yyyymmddhhnnsszzz', Now) + '.png'; - // Result := '.\img\' + FormatDateTime('yyyymmddhhnnsszzz', Now) + '.png'; - vPng.SaveToFile(Result); - vPng.Free; - Graphics.Free; - font.Free; - sf.free; - b3.free; - b2.free; + finally + Graphics.Free; + end; + finally + vPng.Free; + end; end; -procedure TCfgForm.update_db(); +procedure TCfgForm.Buttoaction_translator(Sender: TObject); var - Hash: string; - v: string; + hdc1: hdc; + hg, y: Integer; + imgpath, key1, Hash: string; + tmps: string; begin - g_core.dbmgr.itemdb.clean(); - g_core.dbmgr.itemdb.clean(false); - - for var key in g_core.utils.fileMap.Keys do + tmps := LabeledEdit2.Text; + LabeledEdit2.Text := tmps.Replace('=', ''); + //图片 + if rbimg.Checked then begin - v := ''; - if g_core.utils.fileMap.TryGetValue(key, v) then + if (Trim(imgEdit1.Text) <> '') and (Trim(LabeledEdit2.Text) <> '') then begin - Hash := THashMD5.GetHashString(key); - // k v 存储在不同表中 - g_core.dbmgr.itemdb.SetVarValue(Hash, key); - g_core.dbmgr.itemdb.SetVarValue(Hash, v, false); - end; + g_core.utils.CopyFileToFolder(Trim(imgEdit1.Text), ExtractFilePath(ParamStr(0)) + 'img'); - end; + key1 := ExtractFileName(Trim(imgEdit1.Text)); -end; + Hash := THashMD5.GetHashString(key1); -procedure TCfgForm.Button1Click(Sender: TObject); -begin - if rbimg.Checked then - begin - if (Trim(imgEdit1.Text) <> '') and (Trim(LabeledEdit2.Text) <> '') then - begin - if g_core.utils.fileMap.TryAdd(Trim(imgEdit1.Text), Trim(LabeledEdit2.Text)) then + if file_map.TryAdd(Hash, key1 + ',' + Trim(LabeledEdit2.Text) + ',' + Trim(tip.text)) then begin - if (Trim(imgEdit1.Text).Contains('http')) then - ve1.InsertRow((Trim(imgEdit1.Text)), Trim(LabeledEdit2.Text), True) - else - ve1.InsertRow(ExtractFileName(Trim(imgEdit1.Text)), ExtractFileName(Trim(LabeledEdit2.Text)), True); + add_json(Hash, key1, Trim(LabeledEdit2.Text), Trim(tip.text), True, nil); + + ve1.InsertRow(key1, Trim(tip.Text), True); imgEdit1.Text := ''; - LabeledEdit3.Text := ''; + text_edit.Text := ''; LabeledEdit2.Text := ''; + tip.Text := ''; xchange := True; end; end; end + //文字 else if rbtxt.Checked then begin - if (Trim(LabeledEdit2.Text) <> '') and (Trim(LabeledEdit3.Text) <> '') then + if (Trim(LabeledEdit2.Text) <> '') and (Trim(text_edit.Text) <> '') then begin - var hg := Label1.canvas.TextHeight(Trim(LabeledEdit3.Text)); + hdc1 := GetDC(text_edit.Handle); + hg := GetFontHeight(hdc1); + ReleaseDC(Handle, hdc1); + y := Round((128 - hg) div 2); - var y := Round((128 - hg) div 2); + imgpath := GenerateTextImage(Trim(text_edit.Text), y); + g_core.utils.CopyFileToFolder(Trim(imgpath), ExtractFilePath(ParamStr(0)) + 'img'); - var imgpath := text_outa(Trim(LabeledEdit3.Text), y, line_bg1, line_bg2,CheckBox1.Checked); + key1 := ExtractFileName(Trim(imgpath)); - if g_core.utils.fileMap.TryAdd(imgpath, Trim(LabeledEdit2.Text)) then + Hash := THashMD5.GetHashString(key1); + + if file_map.TryAdd(Hash, key1 + ',' + Trim(LabeledEdit2.Text) + ',' + Trim(tip.Text)) then begin - if (Trim(imgpath).Contains('http')) then - ve1.InsertRow((Trim(imgpath)), Trim(LabeledEdit2.Text), True) - else - ve1.InsertRow(ExtractFileName(Trim(imgpath)), ExtractFileName(Trim(LabeledEdit2.Text)), True); + add_json(Hash, key1, Trim(LabeledEdit2.Text), Trim(tip.text), True, nil); + ve1.InsertRow(key1, Trim(tip.Text), True); imgEdit1.Text := ''; - LabeledEdit3.Text := ''; + text_edit.Text := ''; LabeledEdit2.Text := ''; + tip.Text := ''; xchange := True; end @@ -187,55 +208,49 @@ procedure TCfgForm.Button1Click(Sender: TObject); end; -procedure TCfgForm.ColorGrid1Change(Sender: TObject); -begin -line_bg1:= ColorGrid1.ForegroundColor; -end; - -procedure TCfgForm.ColorGrid2Change(Sender: TObject); -begin -line_bg2:= ColorGrid2.ForegroundColor; -end; - procedure TCfgForm.FormClose(Sender: TObject; var Action: TCloseAction); begin - if (OldNum <> g_core.utils.fileMap.Count) or xchange then + if xchange then begin - - update_db(); - Form1.layout; + Form1.ConfigureLayout; end; - g_core.nodes.Is_cfging := false; - + g_core.nodes.is_configuring := false; + file_map.Free; end; procedure TCfgForm.FormShow(Sender: TObject); var - appPath, imgpath: string; + values: TArray; + v: TSettingItem; + tmp_key: string; begin + Form1.Font.Name := Screen.Fonts.Text; + Form1.Font.Size := 9; + file_map := TDictionary.Create; + ve1.Strings.Clear; - var Keys := g_core.dbmgr.itemdb.GetKeys; - for var i := 0 to Keys.Count - 1 do + + for tmp_key in g_core.json.Settings.keys do begin - var key := Keys[i]; - var value := g_core.dbmgr.itemdb.GetString(key); - var altValue := g_core.dbmgr.itemdb.GetString(key, false); - g_core.utils.fileMap.TryAdd(value, altValue); - imgpath := ExtractFileName(value); - if altValue.Contains('http') then - appPath := altValue - else - appPath := ExtractFileName(altValue); - ve1.InsertRow(imgpath, appPath, True); - end; - /// 后面关闭 数据是否变化作用 - OldNum := Keys.Count; - OldValue := g_core.dbmgr.cfgDb.GetInteger('ih'); + if g_core.json.Settings.TryGetValue(tmp_key, v) then + if (v.Is_path_valid) then + begin + file_map.TryAdd(tmp_key, v.image_file_name + ',' + v.FilePath + ',' + v.tool_tip); + + ve1.InsertRow(v.image_file_name, v.tool_tip, True); + + + + end; + end; xchange := false; - line_bg2:=clRed; - line_bg1:=clYellow; + + text_edit.Text := ''; + tip.Text := '无'; + imgEdit1.Text := ''; + LabeledEdit2.Text := ''; end; procedure TCfgForm.imgEdit1DblClick(Sender: TObject); @@ -243,17 +258,19 @@ procedure TCfgForm.imgEdit1DblClick(Sender: TObject); OpenDlg: TOpenDialog; begin OpenDlg := TOpenDialog.Create(nil); - with OpenDlg do - begin - Filter := '文件(*.png)|*.png'; - DefaultExt := '*.png'; - if Execute then + try + OpenDlg.Filter := '文件(*.png)|*.png'; + OpenDlg.DefaultExt := '*.png'; + + if OpenDlg.Execute then begin - imgEdit1.Text := FileName; + imgEdit1.Text := OpenDlg.FileName; end; + + finally + OpenDlg.Free; end; - OpenDlg.free; end; procedure TCfgForm.LabeledEdit2DblClick(Sender: TObject); @@ -261,53 +278,58 @@ procedure TCfgForm.LabeledEdit2DblClick(Sender: TObject); OpenDlg: TOpenDialog; begin OpenDlg := TOpenDialog.Create(nil); - with OpenDlg do - begin - Filter := '文件(*.EXE)|*.EXE'; - DefaultExt := '*.EXE'; + try + OpenDlg.Filter := '文件(*.EXE)|*.EXE'; + OpenDlg.DefaultExt := '*.EXE'; - if Execute then + if OpenDlg.Execute then begin - LabeledEdit2.Text := FileName; + LabeledEdit2.Text := OpenDlg.FileName; end; + finally + OpenDlg.Free; end; end; procedure TCfgForm.rbimgClick(Sender: TObject); begin - LabeledEdit3.Enabled := false; + text_edit.Enabled := false; imgEdit1.Enabled := True; + end; procedure TCfgForm.rbtxtClick(Sender: TObject); begin - LabeledEdit3.Enabled := True; + text_edit.Enabled := True; imgEdit1.Enabled := false; + end; procedure TCfgForm.ve1DblClick(Sender: TObject); +var + pp, key1, Hash: string; + inx: Integer; begin - var pp := ve1.Keys[ve1.Row]; + pp := ve1.Keys[ve1.Row]; if pp = '' then Exit; - begin - var inx: Integer; - for var key in g_core.utils.fileMap.Keys do + key1 := pp; + + Hash := THashMD5.GetHashString(key1); + + for var Key in file_map.Keys do + begin + if Key = Hash then begin - if ExtractFileName(key) = pp then + if ve1.FindRow(pp, inx) then begin - if ve1.FindRow(pp, inx) then - begin - ve1.DeleteRow(inx); - var key_ := HashName(pansichar(key)).ToString; - g_core.utils.fileMap.Remove(key); - g_core.dbmgr.itemdb.DeleteValue(key_); - g_core.dbmgr.itemdb.DeleteValue(key_, false); - xchange := True; - end; - end; + ve1.DeleteRow(inx); + file_map.Remove(Key); + remove_json(Key); + del_json_value('settings',Key); + end; end; end; diff --git a/InfoBarForm.dfm b/InfoBarForm.dfm index cf63131..d7f96f2 100644 --- a/InfoBarForm.dfm +++ b/InfoBarForm.dfm @@ -1,34 +1,38 @@ object bottomForm: TbottomForm Left = 0 Top = 0 - BorderStyle = bsSingle + BorderStyle = bsNone Caption = #24555#25463#24212#29992#38754#26495'---'#40736#26631#25302#20837#24212#29992 - ClientHeight = 457 - ClientWidth = 658 + ClientHeight = 83 + ClientWidth = 674 Color = clBtnFace Font.Charset = DEFAULT_CHARSET Font.Color = clWindowText Font.Height = -12 Font.Name = 'Tahoma' Font.Style = [] - OldCreateOrder = True + OnClose = FormClose OnShow = FormShow - PixelsPerInch = 96 TextHeight = 14 object LVexeinfo: TListView Left = 0 Top = 0 - Width = 658 - Height = 457 + Width = 674 + Height = 83 Hint = #25302#20837#24212#29992 Align = alClient + BevelInner = bvNone + BevelOuter = bvNone + BorderStyle = bsNone Columns = <> + Ctl3D = False LargeImages = ImgList ParentShowHint = False PopupMenu = PopupMenu1 ShowHint = True TabOrder = 0 OnDblClick = LVexeinfoDblClick + OnMouseDown = LVexeinfoMouseDown end object ImgList: TImageList Height = 32 @@ -576,7 +580,7 @@ object bottomForm: TbottomForm Top = 232 object N1: TMenuItem Caption = #21024#38500 - OnClick = N1Click + OnClick = action_translator end end end diff --git a/InfoBarForm.pas b/InfoBarForm.pas index 5bc3991..2f54c3a 100644 --- a/InfoBarForm.pas +++ b/InfoBarForm.pas @@ -1,12 +1,12 @@ -unit InfoBarForm; +unit InfoBarForm; interface uses Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, - Vcl.StdCtrls, Vcl.ExtCtrls, Winapi.ShellAPI, Vcl.ComCtrls, ActiveX, - shlobj, comobj, System.ImageList, Vcl.ImgList, Vcl.Menus; + Vcl.StdCtrls, Vcl.ExtCtrls, Winapi.ShellAPI, Vcl.ComCtrls, ActiveX, shlobj, + u_json, System.JSON, u_debug, comobj, System.ImageList, Vcl.ImgList, Vcl.Menus; type TbottomForm = class(TForm) @@ -16,34 +16,81 @@ TbottomForm = class(TForm) N1: TMenuItem; procedure FormShow(Sender: TObject); procedure LVexeinfoDblClick(Sender: TObject); - procedure N1Click(Sender: TObject); + procedure action_translator(Sender: TObject); + procedure LVexeinfoMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); + procedure FormClose(Sender: TObject; var Action: TCloseAction); private + into_snap_windows: Boolean; procedure WndProc(var Msg: TMessage); override; procedure DragFileInfo(Msg: TMessage); procedure AddExeInfo(Path, ExeName: string); - function ShowIOO(Path, FileName: string): Boolean; + function Show_app(Path, FileName: string): Boolean; function GetExeName(FileName: string): string; function ExeFromLink(lnkName: string): string; function ChangeFileName(FileName: string): string; procedure LoadIco; procedure CreateDefaultFile; - { Private declarations } - public - { Public declarations } + procedure snap_top_windows; + end; +var + bottomForm: TbottomForm; + implementation {$R *.dfm} + uses core; +procedure sort_layout(hwnd: hwnd; uMsg, idEvent: UINT; dwTime: DWORD); stdcall; +begin + bottomForm.snap_top_windows(); +end; + +procedure TbottomForm.snap_top_windows(); +var + lp: tpoint; +begin + if g_core.nodes.is_configuring then + exit; + + GetCursorPos(lp); + if not PtInRect(self.BoundsRect, lp) and not into_snap_windows then + begin + into_snap_windows := true; + + Left := Screen.Width div 2 - Width div 2; + + if top < top_snap_distance then + begin + top := -(height - visible_height) - 5; + Left := Screen.Width div 2 - Width div 2; + + end; + into_snap_windows := false; + + end + else if top < top_snap_distance then + top := 0; +end; + +procedure TbottomForm.FormClose(Sender: TObject; var Action: TCloseAction); +begin + KillTimer(Handle, 10); +end; + procedure TbottomForm.FormShow(Sender: TObject); begin + g_core.utils.round_rect(width, height, Handle); + into_snap_windows := false; + SetTimer(Handle, 10, 10, @sort_layout); DragAcceptFiles(Handle, True); CreateDefaultFile(); LoadIco(); + end; procedure TbottomForm.WndProc(var Msg: TMessage); @@ -68,7 +115,7 @@ procedure TbottomForm.CreateDefaultFile; Freemem(sysdir, 100); end; - if LVexeinfo.Items.Count = 0 then //���ļ� + if LVexeinfo.Items.Count = 0 then begin AddExeInfo(SysTemDir + '\notepad.exe', 'notepad'); AddExeInfo(SysTemDir + '\calc.exe', 'calc'); @@ -87,7 +134,7 @@ procedure TbottomForm.DragFileInfo(Msg: TMessage); strFileName: string; begin pFileName := @arrFileName; - number := DragQueryFile(Msg.wParam, $FFFFFFFF, nil, 0); //����ļ��ĸ��� + number := DragQueryFile(Msg.wParam, $FFFFFFFF, nil, 0); for i := 0 to number - 1 do begin @@ -114,7 +161,7 @@ function TbottomForm.ExeFromLink(lnkName: string): string; MyPFile := aObj as IPersistFile; MyLink := aObj as IShellLink; - WFileName := lnkName; //��һ��String����WideString��ת��������Delphi�Զ���� + WFileName := lnkName; MyPFile.Load(PWChar(WFileName), 0); MyLink.GetPath(FileName, 255, pfd, SLGP_UNCPRIORITY); @@ -149,7 +196,13 @@ procedure TbottomForm.LVexeinfoDblClick(Sender: TObject); end; -procedure TbottomForm.N1Click(Sender: TObject); +procedure TbottomForm.LVexeinfoMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); +begin + ReleaseCapture; + SendMessage(handle, WM_SYSCOMMAND, SC_MOVE + HTCaption, 0); +end; + +procedure TbottomForm.action_translator(Sender: TObject); var IP: Integer; FilePath: string; @@ -162,7 +215,7 @@ procedure TbottomForm.N1Click(Sender: TObject); Node := TListItem.Create(NIl); if LVexeinfo.SelCount > 0 then - if MessageBox(handle, 'ȷ��', 'ɾ��', MB_ICONQUESTION + MB_YESNO) <> IDYes then + if MessageBox(handle, 'delete', 'ok', MB_ICONQUESTION + MB_YESNO) <> IDYes then Exit; for i := LVexeinfo.Items.Count - 1 downto 0 do @@ -178,7 +231,7 @@ procedure TbottomForm.N1Click(Sender: TObject); FilePath := ExtractFileName(FilePath); - g_core.dbmgr.desktopdb.DeleteValue(FilePath); + del_json_value('ini', FilePath.ToUpper); Node.Delete; end; @@ -188,80 +241,68 @@ procedure TbottomForm.AddExeInfo(Path, ExeName: string); var FileName: string; begin - if Path = '' then - Exit; - - if not (FileExists(Path) or DirectoryExists(Path)) then - begin + if (Path = '') or (not (FileExists(Path)) or DirectoryExists(Path)) then Exit; - end; - FileName := Path; //�����ļ��� FileName := ExtractFileName(Path); - var va := g_core.dbmgr.desktopdb.GetString(ExeName); + + var c := FileName.Split(['.'])[0].ToUpper; + var va := get_json_value('ini', c); + if (va <> '') then exit; FileName := ChangeFileName(FileName); - g_core.dbmgr.desktopdb.SetVarValue(FileName, Path); - ShowIOO(Path, FileName); //��ʾͼ�� + set_json_value('ini', FileName.ToUpper, Path); + Show_app(Path, FileName); end; procedure TbottomForm.LoadIco; var i: Integer; + Pair: TJSONPair; begin for i := 0 to LVexeinfo.Items.Count - 1 do begin LVexeinfo.Items.Delete(0); end; - var keys := g_core.dbmgr.desktopdb.GetKeys; - for var key in keys do - ShowIOO(g_core.dbmgr.desktopdb.GetString(key), key); //��ʾͼ�� + var iniObj := g_jsonobj.GetValue('ini') as TJSONObject; + if Assigned(iniObj) then + begin + try + for Pair in iniObj do + begin + var Key := Pair.JsonString.Value; + + Show_app(iniObj.GetValue(Key).GetValue, Key); + end; + finally + end; + end; end; function TbottomForm.ChangeFileName(FileName: string): string; begin if UpperCase(FileName) = 'NOTEPAD.EXE' then - begin - - Result := 'NOTEPAD'; - Exit; - end; - - if UpperCase(FileName) = 'CALC.EXE' then - begin - Result := 'CALC'; - Exit; - end; - - if UpperCase(FileName) = 'MSPAINT.EXE' then - begin - Result := 'MSPAINT'; - Exit; - end; - - if UpperCase(FileName) = 'CMD.EXE' then - begin - Result := 'CMD'; - Exit; - end; - - if UpperCase(FileName) = 'MSTSC.EXE' then - begin - Result := 'MSTSC'; - Exit; - end; - Result := FileName; + Result := 'NOTEPAD' + else if UpperCase(FileName) = 'CALC.EXE' then + Result := 'CALC' + else if UpperCase(FileName) = 'MSPAINT.EXE' then + Result := 'MSPAINT' + else if UpperCase(FileName) = 'CMD.EXE' then + Result := 'CMD' + else if UpperCase(FileName) = 'MSTSC.EXE' then + Result := 'MSTSC' + else + Result := FileName; end; - -function TbottomForm.ShowIOO(Path, FileName: string): Boolean; +function TbottomForm.Show_app(Path, FileName: string): Boolean; var pIco: TIcon; bmpIco: TBitmap; @@ -280,7 +321,7 @@ function TbottomForm.ShowIOO(Path, FileName: string): Boolean; if pIco.Handle > 0 then begin bmpIco := TBitmap.Create; - bmpIco.PixelFormat := pf24bit; //����ͼ�� + bmpIco.PixelFormat := pf32bit; bmpIco.Height := pIco.Height; bmpIco.Width := pIco.Width; bmpIco.Canvas.Draw(0, 0, pIco); @@ -291,13 +332,8 @@ function TbottomForm.ShowIOO(Path, FileName: string): Boolean; item.SubItems.Add(Path); item.ImageIndex := ImgList.Add(bmpIco, bmpIco); - // AddExeInfo(Path,FileName); end; end - else - begin - // DestTopDB.DeleteRecord(LoginID,EID,Path); - end; end; end. diff --git a/README.md b/README.md index 7129fc4..f9f6ace 100644 --- a/README.md +++ b/README.md @@ -1,22 +1,13 @@ -tag中下载 可执行 - -最新源码暂没有提交 反馈上bug 修改后再提交 - -国产 startDock QQ交流群 246233219 +开发环境 delphi 10.4.2 +mac 工具条 win实现，比较粗糙 做了一下升级 方便使用 #### 应用截图 - - -![image](https://github.com/msfm2018/win_mac_tool/blob/v4.1/image/ok.png) ![image](https://github.com/msfm2018/win_mac_tool/blob/v2.2/b.png) ![image](https://github.com/msfm2018/win_mac_tool/blob/v2.2/a.png) ![image](https://github.com/msfm2018/win_mac_tool/blob/v2.2/c.png) +![image](https://github.com/msfm2018/win_mac_tool/blob/v4.0/image/a01.png) - - - - - - +![image](https://github.com/msfm2018/win_mac_tool/blob/v4.0/image/i1.png) +![image](https://github.com/msfm2018/win_mac_tool/blob/v4.0/image/i2.png) diff --git a/WinBarOS.dpr b/WinBarOS.dpr index f9f49db..5dccc70 100644 --- a/WinBarOS.dpr +++ b/WinBarOS.dpr @@ -1,14 +1,15 @@ program WinBarOS; uses +//FastMM4, Forms, windows, ApplicationMain in 'ApplicationMain.pas' {Form1}, ConfigurationForm in 'ConfigurationForm.pas' {mycfg}, core in 'core\core.pas', - core_db in 'core\core_db.pas', event in 'core\event.pas', - InfoBarForm in 'InfoBarForm.pas' {bottomForm}; + InfoBarForm in 'InfoBarForm.pas' {bottomForm}, + u_json in 'core\u_json.pas'; {$R *.res} diff --git a/WinBarOS.dproj b/WinBarOS.dproj index 96f572f..0eca88c 100644 --- a/WinBarOS.dproj +++ b/WinBarOS.dproj @@ -3,12 +3,12 @@ {43E7F1A5-6A37-4C34-8382-A1714837048E} WinBarOS.dpr True - Debug + Release 3 Application VCL 20.1 - Win32 + Win64 WinBarOS @@ -69,12 +69,13 @@ Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;System;Xml;Data;Datasnap;Web;Soap;Winapi;System.Win;$(DCC_Namespace) 2052 CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments=;CFBundleName= + "Amethyst Kamri|VCLSTYLE|$(BDSCOMMONDIR)\Styles\AmethystKamri.vsf" Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace) Debug true - CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments=;ProgramID=com.embarcadero.$(MSBuildProjectName) + CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments= 1033 $(BDS)\bin\default_app.manifest tsFm_Icon1.ico @@ -112,14 +113,13 @@ .\dcu - true PerMonitorV2 - ../bin + ./bin true 1033 CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments= $(BDS)\bin\delphi_PROJECTICON.ico - C:\Users\Administrator\Desktop\git\win_mac_tool\core;$(DCC_UnitSearchPath) + .\core;$(DCC_UnitSearchPath) DEBUG;$(DCC_Define) @@ -136,13 +136,11 @@ CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments=;ProgramID=com.embarcadero.$(MSBuildProjectName) .\bin WinBarOS_Icon2.ico - true - true PerMonitorV2 - .\sqlite;.\core;$(DCC_UnitSearchPath) - .\bin64 + .\core;.\FastMM4-master;$(DCC_UnitSearchPath) + .\bin true 1033 CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments= @@ -159,12 +157,11 @@
mycfg
-
bottomForm
- dfm + Base @@ -186,8 +183,10 @@ WinBarOS.dpr - Microsoft Office 2000 Sample Automation Server Wrapper Components - Microsoft Office XP Sample Automation Server Wrapper Components + Embarcadero C++Builder Office 2000 Servers Package + Embarcadero C++Builder Office XP Servers Package + Microsoft Office 2000 Sample Automation Server Wrapper Components + Microsoft Office XP Sample Automation Server Wrapper Components @@ -197,6 +196,18 @@ + + + WinBarOS.exe + true + + + + + WinBarOS.exe + true + + diff --git a/WinBarOS.dproj.local b/WinBarOS.dproj.local index 27ee930..60b84bd 100644 --- a/WinBarOS.dproj.local +++ b/WinBarOS.dproj.local @@ -1,24 +1,41 @@  - 2022/06/27 00:05:22.000.749,=C:\Users\Administrator\Desktop\git\win_mac_tool\core\CoreDB.pas - 2022/06/27 00:05:53.000.882,=C:\Users\Administrator\Desktop\git\win_mac_tool\sqlite\sqlite3udf.pas - 2022/06/27 00:05:53.000.929,=C:\Users\Administrator\Desktop\git\win_mac_tool\sqlite\SQLiteTable3.pas - 2022/06/27 00:05:53.000.836,=C:\Users\Administrator\Desktop\git\win_mac_tool\sqlite\SQLite3.pas - 2022/06/27 09:25:47.000.987,C:\Users\Administrator\Desktop\git\win_mac_tool\main.pas=C:\Users\Administrator\Desktop\git\win_mac_tool\tsForm.pas - 2022/06/27 09:25:47.000.987,C:\Users\Administrator\Desktop\git\win_mac_tool\main.dfm=C:\Users\Administrator\Desktop\git\win_mac_tool\tsForm.dfm - 2022/06/27 09:30:13.000.877,C:\Users\Administrator\Desktop\git\win_mac_tool\cfgForm.pas=C:\Users\Administrator\Desktop\git\win_mac_tool\cfg_form.pas - 2022/06/27 09:30:13.000.877,C:\Users\Administrator\Desktop\git\win_mac_tool\cfgForm.dfm=C:\Users\Administrator\Desktop\git\win_mac_tool\cfg_form.dfm - 2022/06/27 09:41:41.000.800,=C:\Users\Administrator\Desktop\git\win_mac_tool\bottom_form.pas - 2022/06/27 09:43:45.000.801,C:\Users\Administrator\Desktop\git\win_mac_tool\tsFm.dproj=C:\Users\Administrator\Desktop\git\win_mac_tool\desktopTool.dproj - 2022/06/27 09:47:26.000.200,C:\Users\Administrator\Desktop\git\win_mac_tool\core\CoreDB.pas=C:\Users\Administrator\Desktop\git\win_mac_tool\core\core_db.pas - 2022/06/27 09:49:51.000.595,C:\Users\Administrator\Desktop\git\win_mac_tool\desktopTool.dproj=C:\Users\Administrator\Desktop\git\win_mac_tool\dTool.dproj - 2023/10/23 22:59:37.000.424,C:\Users\Administrator\Desktop\22222222222\win_mac_tool\dTool.dproj=C:\Users\Administrator\Desktop\22222222222\win_mac_tool\WinBarOS.dproj - 2023/10/23 23:00:58.000.677,C:\Users\Administrator\Desktop\22222222222\win_mac_tool\cfg_form.pas=C:\Users\Administrator\Desktop\22222222222\win_mac_tool\ConfigurationForm.pas - 2023/10/23 23:00:58.000.677,C:\Users\Administrator\Desktop\22222222222\win_mac_tool\cfg_form.dfm=C:\Users\Administrator\Desktop\22222222222\win_mac_tool\ConfigurationForm.dfm - 2023/10/23 23:03:12.000.370,C:\Users\Administrator\Desktop\22222222222\win_mac_tool\bottom_form.dfm=C:\Users\Administrator\Desktop\22222222222\win_mac_tool\InfoBarForm.dfm - 2023/10/23 23:03:12.000.370,C:\Users\Administrator\Desktop\22222222222\win_mac_tool\bottom_form.pas=C:\Users\Administrator\Desktop\22222222222\win_mac_tool\InfoBarForm.pas - 2023/10/23 23:07:51.000.520,C:\Users\Administrator\Desktop\22222222222\win_mac_tool\main.dfm=C:\Users\Administrator\Desktop\22222222222\win_mac_tool\ApplicationMain.dfm - 2023/10/23 23:07:51.000.520,C:\Users\Administrator\Desktop\22222222222\win_mac_tool\main.pas=C:\Users\Administrator\Desktop\22222222222\win_mac_tool\ApplicationMain.pas + 1899-12-30 00:00:00.000.370,C:\Users\Administrator\Desktop\22222222222\win_mac_tool\bottom_form.dfm=C:\Users\Administrator\Desktop\22222222222\win_mac_tool\InfoBarForm.dfm + 1899-12-30 00:00:00.000.877,C:\Users\Administrator\Desktop\git\win_mac_tool\cfgForm.pas=C:\Users\Administrator\Desktop\git\win_mac_tool\cfg_form.pas + 1899-12-30 00:00:00.000.800,=C:\Users\Administrator\Desktop\git\win_mac_tool\bottom_form.pas + 1899-12-30 00:00:00.000.677,C:\Users\Administrator\Desktop\22222222222\win_mac_tool\cfg_form.dfm=C:\Users\Administrator\Desktop\22222222222\win_mac_tool\ConfigurationForm.dfm + 1899-12-30 00:00:00.000.987,C:\Users\Administrator\Desktop\git\win_mac_tool\main.dfm=C:\Users\Administrator\Desktop\git\win_mac_tool\tsForm.dfm + 1899-12-30 00:00:00.000.836,=C:\Users\Administrator\Desktop\git\win_mac_tool\sqlite\SQLite3.pas + 1899-12-30 00:00:00.000.600,C:\Users\Administrator\Desktop\生产2\core\Blur.pas= + 1899-12-30 00:00:00.000.315,=C:\Users\Administrator\Desktop\生产2\core\Blur.pas + 1899-12-30 00:00:00.000.424,C:\Users\Administrator\Desktop\22222222222\win_mac_tool\dTool.dproj=C:\Users\Administrator\Desktop\22222222222\win_mac_tool\WinBarOS.dproj + 1899-12-30 00:00:00.000.749,=C:\Users\Administrator\Desktop\git\win_mac_tool\core\CoreDB.pas + 1899-12-30 00:00:00.000.200,C:\Users\Administrator\Desktop\git\win_mac_tool\core\CoreDB.pas=C:\Users\Administrator\Desktop\git\win_mac_tool\core\core_db.pas + 1899-12-30 00:00:00.000.929,=C:\Users\Administrator\Desktop\git\win_mac_tool\sqlite\SQLiteTable3.pas + 1899-12-30 00:00:00.000.987,C:\Users\Administrator\Desktop\git\win_mac_tool\main.pas=C:\Users\Administrator\Desktop\git\win_mac_tool\tsForm.pas + 1899-12-30 00:00:00.000.055,C:\Users\Administrator\Desktop\xx11\20240621\Unit1.pas=C:\Users\Administrator\Desktop\xx11\20240621\core\u_json.pas + 1899-12-30 00:00:00.000.328,=C:\Users\Administrator\Desktop\xx11\20240621\Unit1.pas + 1899-12-30 00:00:00.000.520,C:\Users\Administrator\Desktop\22222222222\win_mac_tool\main.dfm=C:\Users\Administrator\Desktop\22222222222\win_mac_tool\ApplicationMain.dfm + 1899-12-30 00:00:00.000.877,C:\Users\Administrator\Desktop\git\win_mac_tool\cfgForm.dfm=C:\Users\Administrator\Desktop\git\win_mac_tool\cfg_form.dfm + 1899-12-30 00:00:00.000.037,=C:\Users\Administrator\Desktop\生产2\core\Gdiplus.pas + 1899-12-30 00:00:00.000.370,C:\Users\Administrator\Desktop\22222222222\win_mac_tool\bottom_form.pas=C:\Users\Administrator\Desktop\22222222222\win_mac_tool\InfoBarForm.pas + 1899-12-30 00:00:00.000.520,C:\Users\Administrator\Desktop\22222222222\win_mac_tool\main.pas=C:\Users\Administrator\Desktop\22222222222\win_mac_tool\ApplicationMain.pas + 1899-12-30 00:00:00.000.677,C:\Users\Administrator\Desktop\22222222222\win_mac_tool\cfg_form.pas=C:\Users\Administrator\Desktop\22222222222\win_mac_tool\ConfigurationForm.pas + 1899-12-30 00:00:00.000.801,C:\Users\Administrator\Desktop\git\win_mac_tool\tsFm.dproj=C:\Users\Administrator\Desktop\git\win_mac_tool\desktopTool.dproj + 1899-12-30 00:00:00.000.595,C:\Users\Administrator\Desktop\git\win_mac_tool\desktopTool.dproj=C:\Users\Administrator\Desktop\git\win_mac_tool\dTool.dproj + 1899-12-30 00:00:00.000.882,=C:\Users\Administrator\Desktop\git\win_mac_tool\sqlite\sqlite3udf.pas + + + + + + + + + + + + diff --git a/WinBarOS.identcache b/WinBarOS.identcache index 30397b4..83125b2 100644 Binary files a/WinBarOS.identcache and b/WinBarOS.identcache differ diff --git a/WinBarOS.res b/WinBarOS.res index 2833071..d800631 100644 Binary files a/WinBarOS.res and b/WinBarOS.res differ diff --git a/WinBarOS_Icon.ico b/WinBarOS_Icon.ico deleted file mode 100644 index 1ce891e..0000000 Binary files a/WinBarOS_Icon.ico and /dev/null differ diff --git a/WinBarOS_Icon1.ico b/WinBarOS_Icon1.ico deleted file mode 100644 index 38d3d4f..0000000 Binary files a/WinBarOS_Icon1.ico and /dev/null differ diff --git a/bin/UserSettingsDB.db b/bin/UserSettingsDB.db deleted file mode 100644 index 4056676..0000000 Binary files a/bin/UserSettingsDB.db and /dev/null differ diff --git a/bin/WinBarOS.exe b/bin/WinBarOS.exe new file mode 100644 index 0000000..7f16f52 Binary files /dev/null and b/bin/WinBarOS.exe differ diff --git a/bin/cfg.json b/bin/cfg.json new file mode 100644 index 0000000..767737d --- /dev/null +++ b/bin/cfg.json @@ -0,0 +1 @@ +{"settings":{"8f5835b752dbaefc4dd10de081dfb208":{"imagefilename":"Acrobat.png","path":"https:\/\/baidu.com","tooltip":"\u4EC0\u4E48"},"recycle":{"imagefilename":"recycle.png","path":"recycle","tooltip":"\u56DE\u6536\u7AD9"},"startx":{"imagefilename":"Start Button.png","path":"startx","tooltip":"\u5F00\u59CB\u83DC\u5355"},"219cc8fb5159bc7bb0dc342b3767c6c2":{"imagefilename":"wx.png","path":"C:\\Thunder\\Program\\Thunder.exe","tooltip":"\u65E0"}},"config":{"debug":"false","nodesize":68,"translator":"https:\/\/fanyi.sogou.com","shortcut":"C:\\leidian\\LDPlayer9\\dnplayer.exe","left":"654","top":"883"},"exclusion":{"value":"TextInputHost.exe,ApplicationFrameHost.exe,WinBarOS.exe,SystemSettings.exe"},"ini":{"NOTEPAD":"C:\\Windows\\system32\\notepad.exe","CALC":"C:\\Windows\\system32\\calc.exe","CMD":"C:\\Windows\\system32\\cmd.exe","MSTSC":"C:\\Windows\\system32\\mstsc.exe","BAIDUNETDISK.EXE":"D:\\BaiduNetdisk\\BaiduNetdisk.exe","QQ.EXE":"C:\\Program Files\\Tencent\\QQNT\\QQ.exe"},"icons":{"NOTEPAD":"NotePad.png","CHROME":"Chrome.png","EXPLORER":"Explorer.png","CODE":"vscode.png","BDS":"delphi.png","FIREWORKS":"fw.png","MSPAINT":"Paint.png","Photoshop":"Adobe Photoshop.png","PAINT":"Paint.png","QQ":"qq.png","MSEDGE":"edge.png","THUNDER":"xl.png","DINGTALK":"dd.png","WECHAT":"wx.png"}} \ No newline at end of file diff --git a/bin/img/01.png b/bin/img/01.png new file mode 100644 index 0000000..1fc3f14 Binary files /dev/null and b/bin/img/01.png differ diff --git a/bin/img/02.png b/bin/img/02.png new file mode 100644 index 0000000..1fc3f14 Binary files /dev/null and b/bin/img/02.png differ diff --git a/bin/img/03.png b/bin/img/03.png new file mode 100644 index 0000000..1fc3f14 Binary files /dev/null and b/bin/img/03.png differ diff --git a/bin/img/04.png b/bin/img/04.png new file mode 100644 index 0000000..1fc3f14 Binary files /dev/null and b/bin/img/04.png differ diff --git a/bin/img/05.png b/bin/img/05.png new file mode 100644 index 0000000..1fc3f14 Binary files /dev/null and b/bin/img/05.png differ diff --git a/bin/img/06.png b/bin/img/06.png new file mode 100644 index 0000000..210eed4 Binary files /dev/null and b/bin/img/06.png differ diff --git a/bin/img/07.png b/bin/img/07.png new file mode 100644 index 0000000..210eed4 Binary files /dev/null and b/bin/img/07.png differ diff --git a/bin/img/1.png b/bin/img/1.png new file mode 100644 index 0000000..1bdf9cb Binary files /dev/null and b/bin/img/1.png differ diff --git a/bin/img/10.png b/bin/img/10.png new file mode 100644 index 0000000..0f2d13f Binary files /dev/null and b/bin/img/10.png differ diff --git a/bin/img/11.png b/bin/img/11.png new file mode 100644 index 0000000..f0ea044 Binary files /dev/null and b/bin/img/11.png differ diff --git a/bin/img/Acrobat.png b/bin/img/Acrobat.png new file mode 100644 index 0000000..1c2c7e5 Binary files /dev/null and b/bin/img/Acrobat.png differ diff --git a/bin/img/Adobe Photoshop.png b/bin/img/Adobe Photoshop.png new file mode 100644 index 0000000..1bdf9cb Binary files /dev/null and b/bin/img/Adobe Photoshop.png differ diff --git a/bin/img/Applications/1.png b/bin/img/Applications/1.png new file mode 100644 index 0000000..1bdf9cb Binary files /dev/null and b/bin/img/Applications/1.png differ diff --git a/bin/img/Applications/13.png b/bin/img/Applications/13.png new file mode 100644 index 0000000..79313f1 Binary files /dev/null and b/bin/img/Applications/13.png differ diff --git a/bin/img/Applications/AOL Instant Messenger (AIM).png b/bin/img/Applications/AOL Instant Messenger (AIM).png new file mode 100644 index 0000000..969c0de Binary files /dev/null and b/bin/img/Applications/AOL Instant Messenger (AIM).png differ diff --git a/bin/img/Applications/Acrobat.png b/bin/img/Applications/Acrobat.png new file mode 100644 index 0000000..1c2c7e5 Binary files /dev/null and b/bin/img/Applications/Acrobat.png differ diff --git a/bin/img/Applications/Adobe Photoshop.png b/bin/img/Applications/Adobe Photoshop.png new file mode 100644 index 0000000..1bdf9cb Binary files /dev/null and b/bin/img/Applications/Adobe Photoshop.png differ diff --git a/bin/img/Applications/America Online (AOL).png b/bin/img/Applications/America Online (AOL).png new file mode 100644 index 0000000..031e042 Binary files /dev/null and b/bin/img/Applications/America Online (AOL).png differ diff --git a/bin/img/Applications/Apple Quicktime.png b/bin/img/Applications/Apple Quicktime.png new file mode 100644 index 0000000..7761f44 Binary files /dev/null and b/bin/img/Applications/Apple Quicktime.png differ diff --git a/bin/img/Applications/Apple iTunes.png b/bin/img/Applications/Apple iTunes.png new file mode 100644 index 0000000..1ba3fad Binary files /dev/null and b/bin/img/Applications/Apple iTunes.png differ diff --git a/bin/img/Applications/Blogger.png b/bin/img/Applications/Blogger.png new file mode 100644 index 0000000..b25e2c0 Binary files /dev/null and b/bin/img/Applications/Blogger.png differ diff --git a/bin/img/Applications/Chrome.png b/bin/img/Applications/Chrome.png new file mode 100644 index 0000000..fb0607a Binary files /dev/null and b/bin/img/Applications/Chrome.png differ diff --git a/bin/img/Applications/Corel Paint Shop Pro.png b/bin/img/Applications/Corel Paint Shop Pro.png new file mode 100644 index 0000000..992c39c Binary files /dev/null and b/bin/img/Applications/Corel Paint Shop Pro.png differ diff --git a/bin/img/Applications/Corel Word Perfect.png b/bin/img/Applications/Corel Word Perfect.png new file mode 100644 index 0000000..1ecbded Binary files /dev/null and b/bin/img/Applications/Corel Word Perfect.png differ diff --git a/bin/img/Applications/Explorer.png b/bin/img/Applications/Explorer.png new file mode 100644 index 0000000..99b83ea Binary files /dev/null and b/bin/img/Applications/Explorer.png differ diff --git a/bin/img/Applications/Firefox.png b/bin/img/Applications/Firefox.png new file mode 100644 index 0000000..b4f1f8a Binary files /dev/null and b/bin/img/Applications/Firefox.png differ diff --git a/bin/img/Applications/Gaim.png b/bin/img/Applications/Gaim.png new file mode 100644 index 0000000..230b977 Binary files /dev/null and b/bin/img/Applications/Gaim.png differ diff --git a/bin/img/Applications/Google Talk.png b/bin/img/Applications/Google Talk.png new file mode 100644 index 0000000..be7a776 Binary files /dev/null and b/bin/img/Applications/Google Talk.png differ diff --git a/bin/img/Applications/Limewire.png b/bin/img/Applications/Limewire.png new file mode 100644 index 0000000..41a5124 Binary files /dev/null and b/bin/img/Applications/Limewire.png differ diff --git a/bin/img/Applications/Microsoft Internet Explorer.png b/bin/img/Applications/Microsoft Internet Explorer.png new file mode 100644 index 0000000..fd7cdca Binary files /dev/null and b/bin/img/Applications/Microsoft Internet Explorer.png differ diff --git a/bin/img/Applications/Microsoft Office - Excel.png b/bin/img/Applications/Microsoft Office - Excel.png new file mode 100644 index 0000000..559b638 Binary files /dev/null and b/bin/img/Applications/Microsoft Office - Excel.png differ diff --git a/bin/img/Applications/Microsoft Office - OneNote.png b/bin/img/Applications/Microsoft Office - OneNote.png new file mode 100644 index 0000000..aca2eeb Binary files /dev/null and b/bin/img/Applications/Microsoft Office - OneNote.png differ diff --git a/bin/img/Applications/Microsoft Office - Outlook.png b/bin/img/Applications/Microsoft Office - Outlook.png new file mode 100644 index 0000000..5bfd54d Binary files /dev/null and b/bin/img/Applications/Microsoft Office - Outlook.png differ diff --git a/bin/img/Applications/Microsoft Office - PowerPoint.png b/bin/img/Applications/Microsoft Office - PowerPoint.png new file mode 100644 index 0000000..5c3ecff Binary files /dev/null and b/bin/img/Applications/Microsoft Office - PowerPoint.png differ diff --git a/bin/img/Applications/Microsoft Office - Publisher.png b/bin/img/Applications/Microsoft Office - Publisher.png new file mode 100644 index 0000000..ad0449f Binary files /dev/null and b/bin/img/Applications/Microsoft Office - Publisher.png differ diff --git a/bin/img/Applications/Microsoft Office - Visio.png b/bin/img/Applications/Microsoft Office - Visio.png new file mode 100644 index 0000000..b2e01e0 Binary files /dev/null and b/bin/img/Applications/Microsoft Office - Visio.png differ diff --git a/bin/img/Applications/Microsoft Office - Word.png b/bin/img/Applications/Microsoft Office - Word.png new file mode 100644 index 0000000..90a0499 Binary files /dev/null and b/bin/img/Applications/Microsoft Office - Word.png differ diff --git a/bin/img/Applications/Microsoft Visual Studio.png b/bin/img/Applications/Microsoft Visual Studio.png new file mode 100644 index 0000000..0860dcb Binary files /dev/null and b/bin/img/Applications/Microsoft Visual Studio.png differ diff --git a/bin/img/Applications/Nero.png b/bin/img/Applications/Nero.png new file mode 100644 index 0000000..e116974 Binary files /dev/null and b/bin/img/Applications/Nero.png differ diff --git a/bin/img/Applications/NotePad.png b/bin/img/Applications/NotePad.png new file mode 100644 index 0000000..113592a Binary files /dev/null and b/bin/img/Applications/NotePad.png differ diff --git a/bin/img/Applications/Opera.png b/bin/img/Applications/Opera.png new file mode 100644 index 0000000..d6b1b25 Binary files /dev/null and b/bin/img/Applications/Opera.png differ diff --git a/bin/img/Applications/Paint.png b/bin/img/Applications/Paint.png new file mode 100644 index 0000000..88ded5b Binary files /dev/null and b/bin/img/Applications/Paint.png differ diff --git a/bin/img/Applications/Skype.png b/bin/img/Applications/Skype.png new file mode 100644 index 0000000..2a33f49 Binary files /dev/null and b/bin/img/Applications/Skype.png differ diff --git a/bin/img/Applications/Stardock Central.png b/bin/img/Applications/Stardock Central.png new file mode 100644 index 0000000..f361dbe Binary files /dev/null and b/bin/img/Applications/Stardock Central.png differ diff --git a/bin/img/Applications/Stardock Component Tray.png b/bin/img/Applications/Stardock Component Tray.png new file mode 100644 index 0000000..322126b Binary files /dev/null and b/bin/img/Applications/Stardock Component Tray.png differ diff --git a/bin/img/Applications/Stardock IconDeveloper.png b/bin/img/Applications/Stardock IconDeveloper.png new file mode 100644 index 0000000..e773d0b Binary files /dev/null and b/bin/img/Applications/Stardock IconDeveloper.png differ diff --git a/bin/img/Applications/Stardock IconPackager.png b/bin/img/Applications/Stardock IconPackager.png new file mode 100644 index 0000000..9cb72f8 Binary files /dev/null and b/bin/img/Applications/Stardock IconPackager.png differ diff --git a/bin/img/Applications/Stardock ObjectDock.png b/bin/img/Applications/Stardock ObjectDock.png new file mode 100644 index 0000000..3544ae1 Binary files /dev/null and b/bin/img/Applications/Stardock ObjectDock.png differ diff --git a/bin/img/Applications/Stardock Theme Manager.png b/bin/img/Applications/Stardock Theme Manager.png new file mode 100644 index 0000000..1b42896 Binary files /dev/null and b/bin/img/Applications/Stardock Theme Manager.png differ diff --git a/bin/img/Applications/Stardock WindowBlinds.png b/bin/img/Applications/Stardock WindowBlinds.png new file mode 100644 index 0000000..b90878f Binary files /dev/null and b/bin/img/Applications/Stardock WindowBlinds.png differ diff --git a/bin/img/Applications/Thunderbird.png b/bin/img/Applications/Thunderbird.png new file mode 100644 index 0000000..095ee33 Binary files /dev/null and b/bin/img/Applications/Thunderbird.png differ diff --git a/bin/img/Applications/Trillian.png b/bin/img/Applications/Trillian.png new file mode 100644 index 0000000..8e469a8 Binary files /dev/null and b/bin/img/Applications/Trillian.png differ diff --git a/bin/img/Applications/Ultra Edit.png b/bin/img/Applications/Ultra Edit.png new file mode 100644 index 0000000..4841111 Binary files /dev/null and b/bin/img/Applications/Ultra Edit.png differ diff --git a/bin/img/Applications/WinAmp.png b/bin/img/Applications/WinAmp.png new file mode 100644 index 0000000..59aba15 Binary files /dev/null and b/bin/img/Applications/WinAmp.png differ diff --git a/bin/img/Applications/WinRar.png b/bin/img/Applications/WinRar.png new file mode 100644 index 0000000..317d6ba Binary files /dev/null and b/bin/img/Applications/WinRar.png differ diff --git a/bin/img/Applications/WinZip.png b/bin/img/Applications/WinZip.png new file mode 100644 index 0000000..0e78c56 Binary files /dev/null and b/bin/img/Applications/WinZip.png differ diff --git a/bin/img/Applications/Windows Live Messenger.png b/bin/img/Applications/Windows Live Messenger.png new file mode 100644 index 0000000..93b7d77 Binary files /dev/null and b/bin/img/Applications/Windows Live Messenger.png differ diff --git a/bin/img/Applications/Windows Media Player.png b/bin/img/Applications/Windows Media Player.png new file mode 100644 index 0000000..4d8df98 Binary files /dev/null and b/bin/img/Applications/Windows Media Player.png differ diff --git a/bin/img/Applications/Yahoo Messenger Message.png b/bin/img/Applications/Yahoo Messenger Message.png new file mode 100644 index 0000000..967318a Binary files /dev/null and b/bin/img/Applications/Yahoo Messenger Message.png differ diff --git a/bin/img/Applications/Yahoo Messenger.png b/bin/img/Applications/Yahoo Messenger.png new file mode 100644 index 0000000..4bea66f Binary files /dev/null and b/bin/img/Applications/Yahoo Messenger.png differ diff --git a/bin/img/Applications/mIRC.png b/bin/img/Applications/mIRC.png new file mode 100644 index 0000000..c0cb078 Binary files /dev/null and b/bin/img/Applications/mIRC.png differ diff --git a/bin/img/Applications/napster.png b/bin/img/Applications/napster.png new file mode 100644 index 0000000..187a3b0 Binary files /dev/null and b/bin/img/Applications/napster.png differ diff --git a/bin/img/Corel Word Perfect.png b/bin/img/Corel Word Perfect.png new file mode 100644 index 0000000..1ecbded Binary files /dev/null and b/bin/img/Corel Word Perfect.png differ diff --git a/bin/img/Firefox.png b/bin/img/Firefox.png new file mode 100644 index 0000000..b4f1f8a Binary files /dev/null and b/bin/img/Firefox.png differ diff --git a/bin/img/Gaim.png b/bin/img/Gaim.png new file mode 100644 index 0000000..230b977 Binary files /dev/null and b/bin/img/Gaim.png differ diff --git a/bin/img/Limewire.png b/bin/img/Limewire.png new file mode 100644 index 0000000..41a5124 Binary files /dev/null and b/bin/img/Limewire.png differ diff --git a/bin/img/Microsoft Visual Studio.png b/bin/img/Microsoft Visual Studio.png new file mode 100644 index 0000000..0860dcb Binary files /dev/null and b/bin/img/Microsoft Visual Studio.png differ diff --git a/bin/img/Misc Icons/Clock 2.png b/bin/img/Misc Icons/Clock 2.png new file mode 100644 index 0000000..4de09ef Binary files /dev/null and b/bin/img/Misc Icons/Clock 2.png differ diff --git a/bin/img/Misc Icons/Clock 3.png b/bin/img/Misc Icons/Clock 3.png new file mode 100644 index 0000000..210eed4 Binary files /dev/null and b/bin/img/Misc Icons/Clock 3.png differ diff --git a/bin/img/Misc Icons/Clock.png b/bin/img/Misc Icons/Clock.png new file mode 100644 index 0000000..1fc3f14 Binary files /dev/null and b/bin/img/Misc Icons/Clock.png differ diff --git a/bin/img/Misc Icons/Computer Desktop.png b/bin/img/Misc Icons/Computer Desktop.png new file mode 100644 index 0000000..589f9f2 Binary files /dev/null and b/bin/img/Misc Icons/Computer Desktop.png differ diff --git a/bin/img/Misc Icons/Configure ObjectDock.png b/bin/img/Misc Icons/Configure ObjectDock.png new file mode 100644 index 0000000..6c1ca2b Binary files /dev/null and b/bin/img/Misc Icons/Configure ObjectDock.png differ diff --git a/bin/img/Misc Icons/Email 2.png b/bin/img/Misc Icons/Email 2.png new file mode 100644 index 0000000..6d10bb6 Binary files /dev/null and b/bin/img/Misc Icons/Email 2.png differ diff --git a/bin/img/Misc Icons/Email.png b/bin/img/Misc Icons/Email.png new file mode 100644 index 0000000..f7ab454 Binary files /dev/null and b/bin/img/Misc Icons/Email.png differ diff --git a/bin/img/Misc Icons/Internet 2.png b/bin/img/Misc Icons/Internet 2.png new file mode 100644 index 0000000..c3c676f Binary files /dev/null and b/bin/img/Misc Icons/Internet 2.png differ diff --git a/bin/img/Misc Icons/Internet.png b/bin/img/Misc Icons/Internet.png new file mode 100644 index 0000000..7370529 Binary files /dev/null and b/bin/img/Misc Icons/Internet.png differ diff --git a/bin/img/Misc Icons/Music CD.png b/bin/img/Misc Icons/Music CD.png new file mode 100644 index 0000000..93f7143 Binary files /dev/null and b/bin/img/Misc Icons/Music CD.png differ diff --git a/bin/img/Misc Icons/My Computer 2.png b/bin/img/Misc Icons/My Computer 2.png new file mode 100644 index 0000000..c39c58c Binary files /dev/null and b/bin/img/Misc Icons/My Computer 2.png differ diff --git a/bin/img/Misc Icons/My Computer.png b/bin/img/Misc Icons/My Computer.png new file mode 100644 index 0000000..7784013 Binary files /dev/null and b/bin/img/Misc Icons/My Computer.png differ diff --git a/bin/img/Misc Icons/Programs Folder.png b/bin/img/Misc Icons/Programs Folder.png new file mode 100644 index 0000000..7b3cbd4 Binary files /dev/null and b/bin/img/Misc Icons/Programs Folder.png differ diff --git a/bin/img/Misc Icons/Question Mark.png b/bin/img/Misc Icons/Question Mark.png new file mode 100644 index 0000000..b2b8737 Binary files /dev/null and b/bin/img/Misc Icons/Question Mark.png differ diff --git a/bin/img/Misc Icons/Recycle Bin - Empty.png b/bin/img/Misc Icons/Recycle Bin - Empty.png new file mode 100644 index 0000000..21f1326 Binary files /dev/null and b/bin/img/Misc Icons/Recycle Bin - Empty.png differ diff --git a/bin/img/Misc Icons/Recycle Bin - Full.png b/bin/img/Misc Icons/Recycle Bin - Full.png new file mode 100644 index 0000000..0125342 Binary files /dev/null and b/bin/img/Misc Icons/Recycle Bin - Full.png differ diff --git a/bin/img/Misc Icons/Search.png b/bin/img/Misc Icons/Search.png new file mode 100644 index 0000000..5f848bf Binary files /dev/null and b/bin/img/Misc Icons/Search.png differ diff --git a/bin/img/Misc Icons/Start Button.png b/bin/img/Misc Icons/Start Button.png new file mode 100644 index 0000000..f0ea044 Binary files /dev/null and b/bin/img/Misc Icons/Start Button.png differ diff --git a/bin/img/Misc Icons/Unload ObjectDock 2.png b/bin/img/Misc Icons/Unload ObjectDock 2.png new file mode 100644 index 0000000..7053b95 Binary files /dev/null and b/bin/img/Misc Icons/Unload ObjectDock 2.png differ diff --git a/bin/img/Misc Icons/Unload ObjectDock.png b/bin/img/Misc Icons/Unload ObjectDock.png new file mode 100644 index 0000000..06f9082 Binary files /dev/null and b/bin/img/Misc Icons/Unload ObjectDock.png differ diff --git a/bin/img/Misc Icons/WinCustomize.png b/bin/img/Misc Icons/WinCustomize.png new file mode 100644 index 0000000..d51dbdd Binary files /dev/null and b/bin/img/Misc Icons/WinCustomize.png differ diff --git a/bin/img/Misc Icons/rt1.png b/bin/img/Misc Icons/rt1.png new file mode 100644 index 0000000..f0ea044 Binary files /dev/null and b/bin/img/Misc Icons/rt1.png differ diff --git a/bin/img/Paint.png b/bin/img/Paint.png new file mode 100644 index 0000000..88ded5b Binary files /dev/null and b/bin/img/Paint.png differ diff --git a/bin/img/Start Button.png b/bin/img/Start Button.png new file mode 100644 index 0000000..f0ea044 Binary files /dev/null and b/bin/img/Start Button.png differ diff --git a/bin/img/a.png b/bin/img/a.png new file mode 100644 index 0000000..a5fc5b4 Binary files /dev/null and b/bin/img/a.png differ diff --git a/bin/img/a1.png b/bin/img/a1.png new file mode 100644 index 0000000..a157ea9 Binary files /dev/null and b/bin/img/a1.png differ diff --git a/bin/img/a2.png b/bin/img/a2.png new file mode 100644 index 0000000..347ab3d Binary files /dev/null and b/bin/img/a2.png differ diff --git a/bin/img/a3.png b/bin/img/a3.png new file mode 100644 index 0000000..3e9348e Binary files /dev/null and b/bin/img/a3.png differ diff --git a/bin/img/a4.png b/bin/img/a4.png new file mode 100644 index 0000000..6128b59 Binary files /dev/null and b/bin/img/a4.png differ diff --git a/bin/img/a5.png b/bin/img/a5.png new file mode 100644 index 0000000..9f050c6 Binary files /dev/null and b/bin/img/a5.png differ diff --git a/bin/img/a6.png b/bin/img/a6.png new file mode 100644 index 0000000..dcefbc1 Binary files /dev/null and b/bin/img/a6.png differ diff --git a/bin/img/a7.png b/bin/img/a7.png new file mode 100644 index 0000000..27124e3 Binary files /dev/null and b/bin/img/a7.png differ diff --git a/bin/img/a8.png b/bin/img/a8.png new file mode 100644 index 0000000..1c5878c Binary files /dev/null and b/bin/img/a8.png differ diff --git a/bin/img/bg--.png b/bin/img/bg--.png new file mode 100644 index 0000000..7098782 Binary files /dev/null and b/bin/img/bg--.png differ diff --git a/bin/img/bg.png b/bin/img/bg.png index cef2792..dfcfff1 100644 Binary files a/bin/img/bg.png and b/bin/img/bg.png differ diff --git a/bin/img/bgn.png b/bin/img/bgn.png new file mode 100644 index 0000000..7098782 Binary files /dev/null and b/bin/img/bgn.png differ diff --git a/bin/img/bgq.png b/bin/img/bgq.png new file mode 100644 index 0000000..f967d42 Binary files /dev/null and b/bin/img/bgq.png differ diff --git a/bin/img/brush.png b/bin/img/brush.png new file mode 100644 index 0000000..3ded2e2 Binary files /dev/null and b/bin/img/brush.png differ diff --git a/bin/img/index.png b/bin/img/index.png new file mode 100644 index 0000000..be61d8d Binary files /dev/null and b/bin/img/index.png differ diff --git a/bin/img/napster.png b/bin/img/napster.png new file mode 100644 index 0000000..187a3b0 Binary files /dev/null and b/bin/img/napster.png differ diff --git a/bin/img/recycle.png b/bin/img/recycle.png new file mode 100644 index 0000000..a244b66 Binary files /dev/null and b/bin/img/recycle.png differ diff --git a/bin/img/smile.png b/bin/img/smile.png new file mode 100644 index 0000000..55dbf14 Binary files /dev/null and b/bin/img/smile.png differ diff --git a/bin/img/template.png b/bin/img/template.png index ffb6f97..522a6b9 100644 Binary files a/bin/img/template.png and b/bin/img/template.png differ diff --git a/bin/img/tmp/1.png b/bin/img/tmp/1.png new file mode 100644 index 0000000..1bdf9cb Binary files /dev/null and b/bin/img/tmp/1.png differ diff --git a/bin/img/tmp/AOL Instant Messenger (AIM).png b/bin/img/tmp/AOL Instant Messenger (AIM).png new file mode 100644 index 0000000..969c0de Binary files /dev/null and b/bin/img/tmp/AOL Instant Messenger (AIM).png differ diff --git a/bin/img/tmp/Acrobat.png b/bin/img/tmp/Acrobat.png new file mode 100644 index 0000000..1c2c7e5 Binary files /dev/null and b/bin/img/tmp/Acrobat.png differ diff --git a/bin/img/tmp/Adobe Photoshop.png b/bin/img/tmp/Adobe Photoshop.png new file mode 100644 index 0000000..1bdf9cb Binary files /dev/null and b/bin/img/tmp/Adobe Photoshop.png differ diff --git a/bin/img/tmp/America Online (AOL).png b/bin/img/tmp/America Online (AOL).png new file mode 100644 index 0000000..031e042 Binary files /dev/null and b/bin/img/tmp/America Online (AOL).png differ diff --git a/bin/img/tmp/Apple Quicktime.png b/bin/img/tmp/Apple Quicktime.png new file mode 100644 index 0000000..7761f44 Binary files /dev/null and b/bin/img/tmp/Apple Quicktime.png differ diff --git a/bin/img/tmp/Apple iTunes.png b/bin/img/tmp/Apple iTunes.png new file mode 100644 index 0000000..1ba3fad Binary files /dev/null and b/bin/img/tmp/Apple iTunes.png differ diff --git a/bin/img/tmp/Blogger.png b/bin/img/tmp/Blogger.png new file mode 100644 index 0000000..b25e2c0 Binary files /dev/null and b/bin/img/tmp/Blogger.png differ diff --git a/bin/img/tmp/Chrome.png b/bin/img/tmp/Chrome.png new file mode 100644 index 0000000..fb0607a Binary files /dev/null and b/bin/img/tmp/Chrome.png differ diff --git a/bin/img/tmp/Clock 2.png b/bin/img/tmp/Clock 2.png new file mode 100644 index 0000000..4de09ef Binary files /dev/null and b/bin/img/tmp/Clock 2.png differ diff --git a/bin/img/tmp/Clock 3.png b/bin/img/tmp/Clock 3.png new file mode 100644 index 0000000..210eed4 Binary files /dev/null and b/bin/img/tmp/Clock 3.png differ diff --git a/bin/img/tmp/Clock.png b/bin/img/tmp/Clock.png new file mode 100644 index 0000000..1fc3f14 Binary files /dev/null and b/bin/img/tmp/Clock.png differ diff --git a/bin/img/tmp/Computer Desktop.png b/bin/img/tmp/Computer Desktop.png new file mode 100644 index 0000000..589f9f2 Binary files /dev/null and b/bin/img/tmp/Computer Desktop.png differ diff --git a/bin/img/tmp/Configure ObjectDock.png b/bin/img/tmp/Configure ObjectDock.png new file mode 100644 index 0000000..6c1ca2b Binary files /dev/null and b/bin/img/tmp/Configure ObjectDock.png differ diff --git a/bin/img/tmp/Corel Paint Shop Pro.png b/bin/img/tmp/Corel Paint Shop Pro.png new file mode 100644 index 0000000..992c39c Binary files /dev/null and b/bin/img/tmp/Corel Paint Shop Pro.png differ diff --git a/bin/img/tmp/Corel Word Perfect.png b/bin/img/tmp/Corel Word Perfect.png new file mode 100644 index 0000000..1ecbded Binary files /dev/null and b/bin/img/tmp/Corel Word Perfect.png differ diff --git a/bin/img/tmp/Email 2.png b/bin/img/tmp/Email 2.png new file mode 100644 index 0000000..6d10bb6 Binary files /dev/null and b/bin/img/tmp/Email 2.png differ diff --git a/bin/img/tmp/Email.png b/bin/img/tmp/Email.png new file mode 100644 index 0000000..f7ab454 Binary files /dev/null and b/bin/img/tmp/Email.png differ diff --git a/bin/img/tmp/Explorer.png b/bin/img/tmp/Explorer.png new file mode 100644 index 0000000..99b83ea Binary files /dev/null and b/bin/img/tmp/Explorer.png differ diff --git a/bin/img/tmp/Firefox.png b/bin/img/tmp/Firefox.png new file mode 100644 index 0000000..b4f1f8a Binary files /dev/null and b/bin/img/tmp/Firefox.png differ diff --git a/bin/img/tmp/Gaim.png b/bin/img/tmp/Gaim.png new file mode 100644 index 0000000..230b977 Binary files /dev/null and b/bin/img/tmp/Gaim.png differ diff --git a/bin/img/tmp/Google Talk.png b/bin/img/tmp/Google Talk.png new file mode 100644 index 0000000..be7a776 Binary files /dev/null and b/bin/img/tmp/Google Talk.png differ diff --git a/bin/img/tmp/Internet 2.png b/bin/img/tmp/Internet 2.png new file mode 100644 index 0000000..c3c676f Binary files /dev/null and b/bin/img/tmp/Internet 2.png differ diff --git a/bin/img/tmp/Internet.png b/bin/img/tmp/Internet.png new file mode 100644 index 0000000..7370529 Binary files /dev/null and b/bin/img/tmp/Internet.png differ diff --git a/bin/img/tmp/Limewire.png b/bin/img/tmp/Limewire.png new file mode 100644 index 0000000..41a5124 Binary files /dev/null and b/bin/img/tmp/Limewire.png differ diff --git a/bin/img/tmp/Microsoft Internet Explorer.png b/bin/img/tmp/Microsoft Internet Explorer.png new file mode 100644 index 0000000..fd7cdca Binary files /dev/null and b/bin/img/tmp/Microsoft Internet Explorer.png differ diff --git a/bin/img/tmp/Microsoft Office - Excel.png b/bin/img/tmp/Microsoft Office - Excel.png new file mode 100644 index 0000000..559b638 Binary files /dev/null and b/bin/img/tmp/Microsoft Office - Excel.png differ diff --git a/bin/img/tmp/Microsoft Office - OneNote.png b/bin/img/tmp/Microsoft Office - OneNote.png new file mode 100644 index 0000000..aca2eeb Binary files /dev/null and b/bin/img/tmp/Microsoft Office - OneNote.png differ diff --git a/bin/img/tmp/Microsoft Office - Outlook.png b/bin/img/tmp/Microsoft Office - Outlook.png new file mode 100644 index 0000000..5bfd54d Binary files /dev/null and b/bin/img/tmp/Microsoft Office - Outlook.png differ diff --git a/bin/img/tmp/Microsoft Office - PowerPoint.png b/bin/img/tmp/Microsoft Office - PowerPoint.png new file mode 100644 index 0000000..5c3ecff Binary files /dev/null and b/bin/img/tmp/Microsoft Office - PowerPoint.png differ diff --git a/bin/img/tmp/Microsoft Office - Publisher.png b/bin/img/tmp/Microsoft Office - Publisher.png new file mode 100644 index 0000000..ad0449f Binary files /dev/null and b/bin/img/tmp/Microsoft Office - Publisher.png differ diff --git a/bin/img/tmp/Microsoft Office - Visio.png b/bin/img/tmp/Microsoft Office - Visio.png new file mode 100644 index 0000000..b2e01e0 Binary files /dev/null and b/bin/img/tmp/Microsoft Office - Visio.png differ diff --git a/bin/img/tmp/Microsoft Office - Word.png b/bin/img/tmp/Microsoft Office - Word.png new file mode 100644 index 0000000..90a0499 Binary files /dev/null and b/bin/img/tmp/Microsoft Office - Word.png differ diff --git a/bin/img/tmp/Microsoft Visual Studio.png b/bin/img/tmp/Microsoft Visual Studio.png new file mode 100644 index 0000000..0860dcb Binary files /dev/null and b/bin/img/tmp/Microsoft Visual Studio.png differ diff --git a/bin/img/tmp/Music CD.png b/bin/img/tmp/Music CD.png new file mode 100644 index 0000000..93f7143 Binary files /dev/null and b/bin/img/tmp/Music CD.png differ diff --git a/bin/img/tmp/My Computer 2.png b/bin/img/tmp/My Computer 2.png new file mode 100644 index 0000000..c39c58c Binary files /dev/null and b/bin/img/tmp/My Computer 2.png differ diff --git a/bin/img/tmp/My Computer.png b/bin/img/tmp/My Computer.png new file mode 100644 index 0000000..7784013 Binary files /dev/null and b/bin/img/tmp/My Computer.png differ diff --git a/bin/img/tmp/Nero.png b/bin/img/tmp/Nero.png new file mode 100644 index 0000000..e116974 Binary files /dev/null and b/bin/img/tmp/Nero.png differ diff --git a/bin/img/tmp/NotePad.png b/bin/img/tmp/NotePad.png new file mode 100644 index 0000000..113592a Binary files /dev/null and b/bin/img/tmp/NotePad.png differ diff --git a/bin/img/tmp/Opera.png b/bin/img/tmp/Opera.png new file mode 100644 index 0000000..d6b1b25 Binary files /dev/null and b/bin/img/tmp/Opera.png differ diff --git a/bin/img/tmp/Paint.png b/bin/img/tmp/Paint.png new file mode 100644 index 0000000..88ded5b Binary files /dev/null and b/bin/img/tmp/Paint.png differ diff --git a/bin/img/tmp/Programs Folder.png b/bin/img/tmp/Programs Folder.png new file mode 100644 index 0000000..7b3cbd4 Binary files /dev/null and b/bin/img/tmp/Programs Folder.png differ diff --git a/bin/img/tmp/Question Mark.png b/bin/img/tmp/Question Mark.png new file mode 100644 index 0000000..b2b8737 Binary files /dev/null and b/bin/img/tmp/Question Mark.png differ diff --git a/bin/img/tmp/Recycle Bin - Empty.png b/bin/img/tmp/Recycle Bin - Empty.png new file mode 100644 index 0000000..21f1326 Binary files /dev/null and b/bin/img/tmp/Recycle Bin - Empty.png differ diff --git a/bin/img/tmp/Recycle Bin - Full.png b/bin/img/tmp/Recycle Bin - Full.png new file mode 100644 index 0000000..0125342 Binary files /dev/null and b/bin/img/tmp/Recycle Bin - Full.png differ diff --git a/bin/img/tmp/Search.png b/bin/img/tmp/Search.png new file mode 100644 index 0000000..5f848bf Binary files /dev/null and b/bin/img/tmp/Search.png differ diff --git a/bin/img/tmp/Skype.png b/bin/img/tmp/Skype.png new file mode 100644 index 0000000..2a33f49 Binary files /dev/null and b/bin/img/tmp/Skype.png differ diff --git a/bin/img/tmp/Stardock Central.png b/bin/img/tmp/Stardock Central.png new file mode 100644 index 0000000..f361dbe Binary files /dev/null and b/bin/img/tmp/Stardock Central.png differ diff --git a/bin/img/tmp/Stardock Component Tray.png b/bin/img/tmp/Stardock Component Tray.png new file mode 100644 index 0000000..322126b Binary files /dev/null and b/bin/img/tmp/Stardock Component Tray.png differ diff --git a/bin/img/tmp/Stardock IconDeveloper.png b/bin/img/tmp/Stardock IconDeveloper.png new file mode 100644 index 0000000..e773d0b Binary files /dev/null and b/bin/img/tmp/Stardock IconDeveloper.png differ diff --git a/bin/img/tmp/Stardock IconPackager.png b/bin/img/tmp/Stardock IconPackager.png new file mode 100644 index 0000000..9cb72f8 Binary files /dev/null and b/bin/img/tmp/Stardock IconPackager.png differ diff --git a/bin/img/tmp/Stardock ObjectDock.png b/bin/img/tmp/Stardock ObjectDock.png new file mode 100644 index 0000000..3544ae1 Binary files /dev/null and b/bin/img/tmp/Stardock ObjectDock.png differ diff --git a/bin/img/tmp/Stardock Theme Manager.png b/bin/img/tmp/Stardock Theme Manager.png new file mode 100644 index 0000000..1b42896 Binary files /dev/null and b/bin/img/tmp/Stardock Theme Manager.png differ diff --git a/bin/img/tmp/Stardock WindowBlinds.png b/bin/img/tmp/Stardock WindowBlinds.png new file mode 100644 index 0000000..b90878f Binary files /dev/null and b/bin/img/tmp/Stardock WindowBlinds.png differ diff --git a/bin/img/tmp/Start Button.png b/bin/img/tmp/Start Button.png new file mode 100644 index 0000000..f0ea044 Binary files /dev/null and b/bin/img/tmp/Start Button.png differ diff --git a/bin/img/tmp/Thunderbird.png b/bin/img/tmp/Thunderbird.png new file mode 100644 index 0000000..095ee33 Binary files /dev/null and b/bin/img/tmp/Thunderbird.png differ diff --git a/bin/img/tmp/Trillian.png b/bin/img/tmp/Trillian.png new file mode 100644 index 0000000..8e469a8 Binary files /dev/null and b/bin/img/tmp/Trillian.png differ diff --git a/bin/img/tmp/Ultra Edit.png b/bin/img/tmp/Ultra Edit.png new file mode 100644 index 0000000..4841111 Binary files /dev/null and b/bin/img/tmp/Ultra Edit.png differ diff --git a/bin/img/tmp/Unload ObjectDock 2.png b/bin/img/tmp/Unload ObjectDock 2.png new file mode 100644 index 0000000..7053b95 Binary files /dev/null and b/bin/img/tmp/Unload ObjectDock 2.png differ diff --git a/bin/img/tmp/Unload ObjectDock.png b/bin/img/tmp/Unload ObjectDock.png new file mode 100644 index 0000000..06f9082 Binary files /dev/null and b/bin/img/tmp/Unload ObjectDock.png differ diff --git a/bin/img/tmp/WinAmp.png b/bin/img/tmp/WinAmp.png new file mode 100644 index 0000000..59aba15 Binary files /dev/null and b/bin/img/tmp/WinAmp.png differ diff --git a/bin/img/tmp/WinCustomize.png b/bin/img/tmp/WinCustomize.png new file mode 100644 index 0000000..d51dbdd Binary files /dev/null and b/bin/img/tmp/WinCustomize.png differ diff --git a/bin/img/tmp/WinRar.png b/bin/img/tmp/WinRar.png new file mode 100644 index 0000000..317d6ba Binary files /dev/null and b/bin/img/tmp/WinRar.png differ diff --git a/bin/img/tmp/WinZip.png b/bin/img/tmp/WinZip.png new file mode 100644 index 0000000..0e78c56 Binary files /dev/null and b/bin/img/tmp/WinZip.png differ diff --git a/bin/img/tmp/Windows Live Messenger.png b/bin/img/tmp/Windows Live Messenger.png new file mode 100644 index 0000000..93b7d77 Binary files /dev/null and b/bin/img/tmp/Windows Live Messenger.png differ diff --git a/bin/img/tmp/Windows Media Player.png b/bin/img/tmp/Windows Media Player.png new file mode 100644 index 0000000..4d8df98 Binary files /dev/null and b/bin/img/tmp/Windows Media Player.png differ diff --git a/bin/img/tmp/Yahoo Messenger Message.png b/bin/img/tmp/Yahoo Messenger Message.png new file mode 100644 index 0000000..967318a Binary files /dev/null and b/bin/img/tmp/Yahoo Messenger Message.png differ diff --git a/bin/img/tmp/Yahoo Messenger.png b/bin/img/tmp/Yahoo Messenger.png new file mode 100644 index 0000000..4bea66f Binary files /dev/null and b/bin/img/tmp/Yahoo Messenger.png differ diff --git a/bin/img/tmp/dd.png b/bin/img/tmp/dd.png new file mode 100644 index 0000000..24feea0 Binary files /dev/null and b/bin/img/tmp/dd.png differ diff --git a/bin/img/tmp/delphi.png b/bin/img/tmp/delphi.png new file mode 100644 index 0000000..c5e61d9 Binary files /dev/null and b/bin/img/tmp/delphi.png differ diff --git a/bin/img/tmp/edge.png b/bin/img/tmp/edge.png new file mode 100644 index 0000000..01fbc17 Binary files /dev/null and b/bin/img/tmp/edge.png differ diff --git a/bin/img/tmp/fw.png b/bin/img/tmp/fw.png new file mode 100644 index 0000000..c9ea959 Binary files /dev/null and b/bin/img/tmp/fw.png differ diff --git a/bin/img/tmp/mIRC.png b/bin/img/tmp/mIRC.png new file mode 100644 index 0000000..c0cb078 Binary files /dev/null and b/bin/img/tmp/mIRC.png differ diff --git a/bin/img/tmp/napster.png b/bin/img/tmp/napster.png new file mode 100644 index 0000000..187a3b0 Binary files /dev/null and b/bin/img/tmp/napster.png differ diff --git a/bin/img/tmp/qq.png b/bin/img/tmp/qq.png new file mode 100644 index 0000000..23d0bf2 Binary files /dev/null and b/bin/img/tmp/qq.png differ diff --git a/bin/img/tmp/rt1.png b/bin/img/tmp/rt1.png new file mode 100644 index 0000000..f0ea044 Binary files /dev/null and b/bin/img/tmp/rt1.png differ diff --git a/bin/img/tmp/task.png b/bin/img/tmp/task.png new file mode 100644 index 0000000..7464db4 Binary files /dev/null and b/bin/img/tmp/task.png differ diff --git a/bin/img/tmp/vscode.png b/bin/img/tmp/vscode.png new file mode 100644 index 0000000..1c1110b Binary files /dev/null and b/bin/img/tmp/vscode.png differ diff --git a/bin/img/tmp/wx.png b/bin/img/tmp/wx.png new file mode 100644 index 0000000..19a0502 Binary files /dev/null and b/bin/img/tmp/wx.png differ diff --git a/bin/img/tmp/xl.png b/bin/img/tmp/xl.png new file mode 100644 index 0000000..7da52ca Binary files /dev/null and b/bin/img/tmp/xl.png differ diff --git a/bin/img/wx.png b/bin/img/wx.png new file mode 100644 index 0000000..19a0502 Binary files /dev/null and b/bin/img/wx.png differ diff --git a/bin/sqlite3.dll b/bin/sqlite3.dll deleted file mode 100644 index 440619c..0000000 Binary files a/bin/sqlite3.dll and /dev/null differ diff --git a/core/core.pas b/core/core.pas index bb252fb..5acbb90 100644 --- a/core/core.pas +++ b/core/core.pas @@ -3,99 +3,599 @@ interface uses - shellapi, Wininet, classes, winapi.windows, Graphics, SysUtils, UrlMon, - Tlhelp32, messages, core_db, Registry, aclapi, AccCtrl, forms, vcl.controls, - shlobj, ComObj, activex, System.Generics.Collections, System.Hash, - ConfigurationForm, InfoBarForm, vcl.ExtCtrls, math; + shellapi, classes, winapi.windows, Graphics, SysUtils, messages, + Vcl.Imaging.pngimage, Vcl.VirtualImage, System.IniFiles, Registry, forms, GDIPAPI, GDIPOBJ, + u_json, vcl.controls, ComObj, System.Generics.Collections, System.Hash, + ConfigurationForm, InfoBarForm, TlHelp32, Winapi.PsAPI, System.SyncObjs, + vcl.ExtCtrls, math; type - TNode = class(TImage) + t_node = class(TImage) public - node_path: string; - node_left: Integer; // 每个节点靠左位置 + key: string; + id: Integer; + tool_tip: string; + file_path: string; + original_width, original_height: Integer; center_x, center_y: Integer; end; - TNodes = record - size: Integer; - nodes_array: array of TNode; - Is_cfging: Boolean; - + t_node_container = record + count: Integer; + Nodes: array of t_node; + is_configuring: Boolean; node_size: Integer; node_gap: Integer; end; - TUtils = record - FileMap: TDictionary; - short_key: string; + t_utils = record + public + procedure round_rect(w, h: Integer; hdl: thandle); + + procedure SetTaskbarAutoHide(autoHide: Boolean); + + procedure CopyFileToFolder(const SourceFile, DestinationFolder: string); public - procedure UpdateDB; procedure launch_app(const Path: string); - procedure AutoRun; + procedure auto_run; + procedure init_background(img: TImage; obj: tform); + function rate(a, b: double): Double; + end; - TCoreClass = class + t_core_class = class public - dbmgr: TGDB; - utils: TUtils; - nodes: TNodes; + json: TMySettings; + utils: t_utils; + nodes: t_node_container; private - map: TDictionary; + object_map: TDictionary; public - function FindObjectByName(const Name_: string): TObject; + function find_object_by_name(const Name_: string): TObject; end; type - TMenuClickHandler = procedure(Sender: TObject) of object; + t_menu_click_handler = procedure(Sender: TObject) of object; const - menu_name: array[0..4] of string = ('翻译', '应用', '设置', '热键', '退出'); - visible_height: Integer = 19; // 代表可见高度 - top_snap_distance: Integer = 40; // 吸附距离 + menu_labels: array[0..6] of string = ('翻译', '应用', '设置', '热键', '退出', '隐藏任务栏', '隐藏桌面图标'); + visible_height = 19; // 代表可见高度 + top_snap_distance = 40; // 吸附距离 + exptend = 60; + +procedure GetRunningApplications(AppList: TStringList); + +function BringWindowToFront(const WindowTitle: string): boolean; + +procedure BmpToPng(const Bmp: TBitmap; PngFileName: string); + +function BmpToPngObj(const Bmp: TBitmap): TPNGImage; + +function GetFontHeight(hdc: HDC): Integer; + +procedure remove_json(Key: string); + +procedure add_json(Key, image_file_name, FilePath, tool_tip: string; Is_path_valid: boolean; memory: TMemoryStream); + +procedure SimulateCtrlEsc; + +procedure EmptyRecycleBin; + +procedure ShowDesktopIcons; + //隐藏桌面图标 + +procedure HideDesktopIcons; + +procedure UpdateCoreSettingsFromTmpJson(const tmp_json: TDictionary; var core_settings: TDictionary; cs: TCriticalSection); var - g_core: TCoreClass; + g_core: t_core_class; + original_task_list: TStringList; + task_list: TStringList; + exclusion_app: string; + app_path: string; implementation -procedure TUtils.UpdateDB; +const + SPI_SETDESKWALLPAPER = $0014; + SPI_GETDESKWALLPAPER = $0073; + SPI_GETDESKPATTERN = $0020; + SPI_SETDESKPATTERN = $0015; + SPI_SETWORKAREA = $002F; + SPI_GETWORKAREA = $0030; + +procedure UpdateCoreSettingsFromTmpJson(const tmp_json: TDictionary; var core_settings: TDictionary; cs: TCriticalSection); +var + tmp_key: string; + settingItem: TSettingItem; + existingItem: TSettingItem; + v: TSettingItem; +begin + cs.Enter; + try + for tmp_key in core_settings.Keys do + begin + if core_settings.TryGetValue(tmp_key, v) then + if not v.Is_path_valid then + begin + if not tmp_json.TryGetValue(tmp_key, settingItem) then + core_settings.Remove(tmp_key); + end; + + end; + + for tmp_key in tmp_json.Keys do + begin + settingItem := tmp_json[tmp_key]; + if not settingItem.Is_path_valid then + begin + if core_settings.TryGetValue(tmp_key, existingItem) then + begin +// // Update existing entry in core_settings +// existingItem.memory_image := settingItem.memory_image; +// existingItem.Is_path_valid := false; +// existingItem.Path := settingItem.Path; +// existingItem.Content := settingItem.Content; + end + else + begin + core_settings.Add(tmp_key, settingItem); + end; + end; + end; + finally + cs.Leave; + end; +end; + +procedure HideDesktopIcons; +var + hDesktopListView: HWND; +begin + hDesktopListView := FindWindowEx(FindWindow('Progman', 'Program Manager'), 0, 'SHELLDLL_DefView', nil); + hDesktopListView := FindWindowEx(hDesktopListView, 0, 'SysListView32', nil); + if hDesktopListView <> 0 then + ShowWindow(hDesktopListView, SW_HIDE); +end; + +procedure ShowDesktopIcons; +var + hDesktopListView: HWND; +begin + hDesktopListView := FindWindowEx(FindWindow('Progman', 'Program Manager'), 0, 'SHELLDLL_DefView', nil); + hDesktopListView := FindWindowEx(hDesktopListView, 0, 'SysListView32', nil); + if hDesktopListView <> 0 then + ShowWindow(hDesktopListView, SW_SHOW); +end; + + +//清空回收站 +procedure EmptyRecycleBin; +begin + + SHEmptyRecycleBin(0, nil, SHERB_NOCONFIRMATION or SHERB_NOPROGRESSUI or SHERB_NOSOUND); +end; + +procedure SimulateCtrlEsc; +begin + // Simulate Ctrl key down + keybd_event(VK_CONTROL, 0, 0, 0); + + // Simulate Esc key down + keybd_event(VK_ESCAPE, 0, 0, 0); + + // Simulate Esc key up + keybd_event(VK_ESCAPE, 0, KEYEVENTF_KEYUP, 0); + + // Simulate Ctrl key up + keybd_event(VK_CONTROL, 0, KEYEVENTF_KEYUP, 0); +end; + +procedure t_utils.CopyFileToFolder(const SourceFile, DestinationFolder: string); var - Hash: string; - Key, Value: string; + DestinationFile: string; begin - g_core.dbmgr.itemdb.Clean; - g_core.dbmgr.itemdb.Clean(False); + DestinationFile := IncludeTrailingPathDelimiter(DestinationFolder) + ExtractFileName(SourceFile); - for Key in FileMap.Keys do + if SourceFile <> DestinationFile then begin - Value := FileMap[Key]; - Hash := THashMD5.GetHashString(Key); + if not CopyFile(PChar(SourceFile), PChar(DestinationFile), False) then + begin + RaiseLastOSError; // 抛出最后一个操作系统错误 + end; + end; +end; + +function GetFontHeight(hdc: hdc): Integer; +var + tm: TTextMetric; +begin + GetTextMetrics(hdc, tm); + Result := tm.tmHeight; +end; + +procedure BmpToPng(const Bmp: TBitmap; PngFileName: string); +var + Png: TPNGImage; + x, y: Integer; + TransparentColor: TColor; +begin + + try + Png := TPNGImage.Create; + try + Png.Assign(Bmp); + Png.CreateAlpha; + + TransparentColor := Bmp.Canvas.Pixels[0, 0]; + + for y := 0 to Bmp.Height - 1 do + begin + for x := 0 to Bmp.Width - 1 do + begin + if Bmp.Canvas.Pixels[x, y] = TransparentColor then + Png.AlphaScanline[y][x] := 0 // 透明 + else + Png.AlphaScanline[y][x] := 255; // 不透明 + end; + end; + + Png.SaveToFile(PngFileName); + finally + Png.Free; + end; + except - g_core.dbmgr.itemdb.SetVarValue(Hash, Key); - g_core.dbmgr.itemdb.SetVarValue(Hash, Value, False); end; end; -procedure TUtils.AutoRun; +function BmpToPngObj1(const Bmp: TBitmap): TPNGImage; +var + Png: TPNGImage; + x, y: Integer; + TransparentColor: TColor; +begin + + try + Png := TPNGImage.Create; + try + Png.Assign(Bmp); + Png.CreateAlpha; + + TransparentColor := Bmp.Canvas.Pixels[0, 0]; + + for y := 0 to Bmp.Height - 1 do + begin + for x := 0 to Bmp.Width - 1 do + begin + if Bmp.Canvas.Pixels[x, y] = TransparentColor then + Png.AlphaScanline[y][x] := 0 // 透明 + else + Png.AlphaScanline[y][x] := 255; // 不透明 + end; + end; + +// Png.SaveToFile(PngFileName); + finally +// Png.Free; + result := Png; + end; + except + + end; +end; + + + +function BmpToPngObj(const Bmp: TBitmap): TPNGImage; +var + GdiBitmap: TGPBitmap; + GdiGraphics: TGPGraphics; + TransparentColor: TColor; + x, y: Integer; + MemoryStream: TMemoryStream; + BmpStream: TStreamAdapter; + PixelColor: TColor; + Alpha: Byte; + SurroundColorCount: Integer; + R, G, B: Integer; + NeighborX, NeighborY: Integer; + NeighborColor: TColor; +// png:TPNGImage; +begin + // 禁用范围检查 + {$R-} +// Png := TPNGImage.Create; + // 创建 GDI+ Bitmap 对象 + MemoryStream := TMemoryStream.Create; + try + Bmp.SaveToStream(MemoryStream); + MemoryStream.Position := 0; + BmpStream := TStreamAdapter.Create(MemoryStream, soReference); + GdiBitmap := TGPBitmap.Create(BmpStream, False); + + try + // 创建 GDI+ Graphics 对象 + GdiGraphics := TGPGraphics.Create(GdiBitmap); + try + // 设置抗锯齿和插值模式 + GdiGraphics.SetSmoothingMode(SmoothingModeHighQuality); + GdiGraphics.SetInterpolationMode(InterpolationModeHighQualityBicubic); + + // 获取透明色 + TransparentColor := Bmp.Canvas.Pixels[0, 0]; + + // 创建新的 PNG 图像 + Result := TPNGImage.Create; + Result.Assign(Bmp); + Result.CreateAlpha; + + // 遍历位图的每个像素 + for y := 0 to Bmp.Height - 1 do + begin + for x := 0 to Bmp.Width - 1 do + begin + PixelColor := Bmp.Canvas.Pixels[x, y]; + if PixelColor = TransparentColor then + begin + Alpha := 0; + end + else + begin + // 检查周围像素的颜色 + R := 0; + G := 0; + B := 0; + SurroundColorCount := 0; + + for NeighborY := Max(0, y - 1) to Min(Bmp.Height - 1, y + 1) do + begin + for NeighborX := Max(0, x - 1) to Min(Bmp.Width - 1, x + 1) do + begin + if (NeighborX <> x) or (NeighborY <> y) then + begin + NeighborColor := Bmp.Canvas.Pixels[NeighborX, NeighborY]; + if NeighborColor <> TransparentColor then + begin + R := R + Integer(GetRValue(NeighborColor)); + G := G + Integer(GetGValue(NeighborColor)); + B := B + Integer(GetBValue(NeighborColor)); + Inc(SurroundColorCount); + end; + end; + end; + end; + + if SurroundColorCount > 0 then + begin + R := R div SurroundColorCount; + G := G div SurroundColorCount; + B := B div SurroundColorCount; + PixelColor := RGB(R, G, B); + end; + + Alpha := 255; // 默认不透明 + end; + Result.AlphaScanline[y][x] := Alpha; + Result.Pixels[x, y] := PixelColor; + end; + end; + + finally +// result:=Png; + GdiGraphics.Free; + end; + + finally + GdiBitmap.Free; + end; + + finally + MemoryStream.Free; + // 恢复范围检查 + {$R+} + end; +end; + + +function GetProcessIcon(PID: DWORD; ab: Boolean): TIcon; +var + hProcess: THandle; + hIcon1: HICON; + hSnapshot: THandle; + me32: MODULEENTRY32; +begin + Result := TIcon.Create; + hSnapshot := CreateToolhelp32Snapshot(TH32CS_SNAPMODULE, PID); + if hSnapshot = INVALID_HANDLE_VALUE then + Exit; + + try + me32.dwSize := SizeOf(MODULEENTRY32); + if Module32First(hSnapshot, me32) then + begin + hProcess := OpenProcess(PROCESS_QUERY_INFORMATION or PROCESS_VM_READ, False, PID); + if hProcess = 0 then + Exit; + + try + hIcon1 := ExtractIcon(hInstance, (me32.szExePath), 0); + if ab then + original_task_list.Add(me32.szExePath) + else + task_list.Add(me32.szExePath); + + if hIcon1 > 1 then + begin + Result.Handle := hIcon1; + end; + finally + CloseHandle(hProcess); + end; + end; + finally + CloseHandle(hSnapshot); + end; +end; + +procedure ListProcessIcons(f: Boolean); +var + hSnapshot: THandle; + pe32: PROCESSENTRY32; + Icon: TIcon; +begin + hSnapshot := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0); + if hSnapshot = INVALID_HANDLE_VALUE then + Exit; + task_list.Clear; + try + pe32.dwSize := SizeOf(PROCESSENTRY32); + if Process32First(hSnapshot, pe32) then + begin + repeat + Icon := GetProcessIcon(pe32.th32ProcessID, f); + try + if not Icon.Empty then + begin + + end; + finally + Icon.Free; + end; + until not Process32Next(hSnapshot, pe32); + end; + finally + CloseHandle(hSnapshot); + end; +end; + +function IsMainWindowVisible(hWnd: hWnd): Boolean; +begin + Result := IsWindowVisible(hWnd) and (GetWindowTextLength(hWnd) > 0); +end; + +function GetProcessFileName(ProcessID: DWORD): string; +var + hProcess: THandle; + FileName: array[0..MAX_PATH] of Char; +begin + Result := ''; + hProcess := OpenProcess(PROCESS_QUERY_INFORMATION or PROCESS_VM_READ, False, ProcessID); + if hProcess <> 0 then + try + if GetModuleFileNameEx(hProcess, 0, FileName, MAX_PATH) > 0 then + Result := FileName; + finally + CloseHandle(hProcess); + end; +end; + +function EnumWindowsProc(hWnd: hWnd; lParam: lParam): BOOL; stdcall; +var + ProcessID: DWORD; + ProcessName: string; + WindowText: array[0..255] of Char; + UniqueProcesses: TStringList; +begin + ZeroMemory(@WindowText, SizeOf(WindowText)); + Result := True; + if IsMainWindowVisible(hWnd) then + begin + GetWindowThreadProcessId(hWnd, ProcessID); + ProcessName := GetProcessFileName(ProcessID); + + UniqueProcesses := TStringList(lParam); + if UniqueProcesses.IndexOf(ExtractFileName(ProcessName)) = -1 then + begin + GetWindowText(hWnd, WindowText, 255); + UniqueProcesses.Add(Format('%s,%s', [ProcessName, WindowText])); + end; + end; +end; + +procedure GetRunningApplications(AppList: TStringList); +begin + AppList.Clear; + EnumWindows(@EnumWindowsProc, lParam(AppList)); +end; + +function BringWindowToFront(const WindowTitle: string): boolean; +var + hWnd: thandle; +begin + result := false; + hWnd := FindWindow(nil, PChar(WindowTitle)); + + if hWnd <> 0 then + begin + if IsIconic(hWnd) then + begin + ShowWindow(hWnd, SW_RESTORE); + end; + SetForegroundWindow(hWnd); + Result := True; + end; +end; + +procedure t_utils.auto_run; begin try var Reg := TRegistry.Create; try Reg.RootKey := HKEY_CURRENT_USER; if Reg.OpenKey('SOFTWARE\Microsoft\Windows\CurrentVersion\Run', True) then - Reg.WriteString('xtool', ExpandFileName(ParamStr(0))); + Reg.WriteString('winbaros', ExpandFileName(ParamStr(0))); finally Reg.Free; end; except - // Handle exception if registry access fails + + end; +end; + +procedure t_utils.SetTaskbarAutoHide(autoHide: Boolean); +var + taskbar: hWnd; + abd: APPBARDATA; +begin + taskbar := FindWindow('Shell_TrayWnd', nil); + if taskbar <> 0 then + begin + abd.cbSize := SizeOf(APPBARDATA); + abd.hWnd := taskbar; + if autoHide then + abd.lParam := ABS_AUTOHIDE + else + abd.lParam := ABS_ALWAYSONTOP; + + SHAppBarMessage(ABM_SETSTATE, abd); end; end; -procedure TUtils.launch_app(const Path: string); +procedure t_utils.init_background(img: TImage; obj: tform); +begin + img.Parent := obj; + img.Align := alClient; + img.Transparent := true; + img.Stretch := true; +// img.Anchors:=[akleft,akright]; + + img.Picture.LoadFromFile(ExtractFilePath(ParamStr(0)) + 'img\bg.png'); +end; + +procedure t_utils.round_rect(w, h: Integer; hdl: thandle); +var + Rgn: HRGN; +begin + Rgn := CreateRoundRectRgn(0, 0, w, h, 8, 8); + SetWindowRgn(hdl, Rgn, true); +end; + +procedure t_utils.launch_app(const Path: string); begin if Path.Trim = '' then Exit; @@ -106,40 +606,85 @@ procedure TUtils.launch_app(const Path: string); ShellExecute(0, 'open', PChar(Path), nil, nil, SW_SHOW); end; -function TCoreClass.FindObjectByName(const Name_: string): TObject; +function t_utils.rate(a, b: double): Double; +begin + result := Exp(-sqrt(a * a + b * b) / (63.82 * 5)); +// result := Exp(-sqrt(a * a + b * b) / (203.82 * 5)); +end; + +function t_core_class.find_object_by_name(const Name_: string): TObject; begin - if map.TryGetValue(Name_, Result) then + if object_map.TryGetValue(Name_, Result) then Exit(Result) else Result := nil; end; + // 添加数据的过程 -initialization - g_core := TCoreClass.Create; - try - g_core.nodes.node_size := g_core.dbmgr.cfgDb.GetInteger('ih'); - except - g_core.nodes.node_size := 64; +procedure add_json(Key, image_file_name, FilePath, tool_tip: string; Is_path_valid: boolean; memory: TMemoryStream); +var + SettingItem: TSettingItem; +begin + SettingItem.image_file_name := image_file_name; + SettingItem.FilePath := FilePath; + SettingItem.tool_tip := tool_tip; + SettingItem.Is_path_valid := Is_path_valid; + SettingItem.memory_image := memory; + + g_core.json.Settings.AddOrSetValue(Key, SettingItem); +end; + +procedure remove_json(Key: string); +var + SettingItem: TSettingItem; +begin + if g_core.json.Settings.ContainsKey(Key) then + begin + SettingItem := g_core.json.Settings[Key]; + if not SettingItem.Is_path_valid then + begin + if Assigned(SettingItem.memory_image) then + begin + SettingItem.memory_image.Free; + SettingItem.memory_image := nil; + end; + end; + g_core.json.Settings.Remove(Key); end; - g_core.nodes.node_gap := Round(g_core.nodes.node_size / 4); // 4 根据 rate 最多增加宽度的一半 +end; + +initialization + g_core := t_core_class.Create; + app_path := ExtractFilePath(ParamStr(0)); + g_jsonobj := load_json_from_file(app_path + 'cfg.json'); + + parse_json(g_jsonobj, g_core.json); - g_core.dbmgr.cfgDb := TCfgDB.Create; - g_core.dbmgr.itemdb := TItemsDb.Create; - g_core.dbmgr.desktopdb := TdesktopDb.Create; - g_core.utils.FileMap := TDictionary.Create; + g_core.object_map := TDictionary.Create; + g_core.object_map.AddOrSetValue('cfgForm', TCfgForm.Create(nil)); - g_core.map := TDictionary.Create; - g_core.map.AddOrSetValue('cfgForm', TCfgForm.Create(nil)); - g_core.map.AddOrSetValue('bottomForm', TbottomForm.Create(nil)); + g_core.utils.auto_run; + original_task_list := TStringList.Create; + task_list := TStringList.Create; - g_core.utils.AutoRun; + try + g_core.nodes.node_size := g_core.json.Config.nodesize; + except + g_core.nodes.node_size := 64; + end; + g_core.nodes.node_gap := Round(g_core.nodes.node_size / 40); finalization - g_core.map.Free; - g_core.utils.FileMap.Free; + g_core.object_map.Free; + g_core.Free; + original_task_list.free; + task_list.free; + + g_jsonobj.Free; + g_core.json.Settings.Free; end. diff --git a/core/event.pas b/core/event.pas index 7fd4307..90f9563 100644 --- a/core/event.pas +++ b/core/event.pas @@ -1,7 +1,7 @@ unit event; interface - + uses winapi.Windows; type TMouseEvent = record isLeftClick: Boolean; @@ -13,7 +13,7 @@ procedure restore_state(); var EventDef: TMouseEvent ; - + cs: TRTLCriticalSection; implementation procedure restore_state(); diff --git a/core/u_json.pas b/core/u_json.pas new file mode 100644 index 0000000..dbaa8f2 --- /dev/null +++ b/core/u_json.pas @@ -0,0 +1,220 @@ +unit u_json; + +interface + +uses + Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, u_debug, + System.Classes, Vcl.Graphics, generics.collections, System.JSON, Vcl.Controls, + System.IOUtils, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls; + +type + TSettingItem = record + image_file_name: string; + FilePath: string; + memory_image: TMemoryStream; + Is_path_valid: Boolean; + tool_tip: string; + end; + + TConfig = record + Left: Integer; + Top: Integer; + nodesize: Integer; + Shortcut: string; + translator: string; + debug: string; + end; + + TExclusion = record + Value: string; + end; + + TMySettings = record + Settings: TDictionary; + Config: TConfig; + Exclusion: TExclusion; + end; + +var + g_jsonobj: TJSONObject; + +function load_json_from_file(const FileName: string): TJSONObject; + +procedure parse_json(JSONObj: TJSONObject; var MySettings: TMySettings); + +procedure set_nodesize_value(var MySettings: TMySettings; NewIHValue: Integer); + +function get_json_value(const Section, Key: string): string; + +procedure set_json_value(const Section, Key, Value: string); + +procedure del_json_value(const Section, Key: string); + +procedure add_or_update(const SettingsJSON: TJSONObject; const Key, imagefilename, Path, tooltip: string); + +procedure SaveJSONToFile(const FileName: string; const JSONObject: TJSONObject); + +implementation + +function get_json_value(const Section, Key: string): string; +var + SectionObj: TJSONObject; +begin + Result := ''; + if Assigned(g_jsonobj) then + begin + SectionObj := g_jsonobj.GetValue(Section) as TJSONObject; + if Assigned(SectionObj) and SectionObj.TryGetValue(Key, Result) then + Exit; + end; +end; + +procedure set_json_value(const Section, Key, Value: string); +var + SectionObj: TJSONObject; +begin + if Assigned(g_jsonobj) then + begin + SectionObj := g_jsonobj.GetValue(Section) as TJSONObject; + if not Assigned(SectionObj) then + begin + SectionObj := TJSONObject.Create; + g_jsonobj.AddPair(Section, SectionObj); + end; + SectionObj.RemovePair(Key).Free; + SectionObj.AddPair(Key, TJSONString.Create(Value)); + end; +end; + +procedure del_json_value(const Section, Key: string); +var + SectionObj: TJSONObject; +begin + if Assigned(g_jsonobj) then + begin + SectionObj := g_jsonobj.GetValue(Section) as TJSONObject; + if not Assigned(SectionObj) then + begin + Exit; + end; + SectionObj.RemovePair(Key).Free; + + end; +end; + +procedure add_or_update(const SettingsJSON: TJSONObject; const Key, imagefilename, Path, tooltip: string); +var + SettingObj: TJSONObject; +begin + SettingObj := TJSONObject.Create; + SettingObj.AddPair('imagefilename', imagefilename); + SettingObj.AddPair('path', Path); + SettingObj.AddPair('tooltip', tooltip); + + SettingsJSON.AddPair(Key, SettingObj); +end; + +procedure Update_config_Value(var MySettings: TMySettings; NewIHValue: Integer; field: string); +begin + // ���� MySettings ��¼�е� ih ֵ + MySettings.Config.nodesize := NewIHValue; + + // ���� JSONObj �е� ih ֵ + if Assigned(g_jsonobj) then + begin + g_jsonobj.GetValue('config').RemovePair(field).Free; + g_jsonobj.GetValue('config').AddPair(field, TJSONNumber.Create(NewIHValue)); + end; +end; + +procedure set_nodesize_value(var MySettings: TMySettings; NewIHValue: Integer); +begin + + Update_config_Value(MySettings, NewIHValue, 'nodesize'); +end; + +procedure SaveJSONToFile(const FileName: string; const JSONObject: TJSONObject); +var + JSONString: string; +begin + JSONString := JSONObject.ToJSON; + TFile.WriteAllText(FileName, JSONString, TEncoding.UTF8); +end; + +function load_json_from_file(const FileName: string): TJSONObject; +var + JSONString: TStringList; + JSONValue: TJSONValue; +begin + JSONString := TStringList.Create; + try + JSONString.LoadFromFile(FileName); + JSONValue := TJSONObject.ParseJSONValue(JSONString.Text); + if not Assigned(JSONValue) or not (JSONValue is TJSONObject) then + raise Exception.Create('Invalid JSON file'); + Result := TJSONObject(JSONValue); + finally + JSONString.Free; + end; +end; + +procedure parse_json(JSONObj: TJSONObject; var MySettings: TMySettings); +var + SettingsObj, ConfigObj, ExclusionObj, IniObj, TmpObj: TJSONObject; + Pair: TJSONPair; + TmpItem: TJSONObject; + Key: string; + SettingItem: TSettingItem; +begin + MySettings.Settings := TDictionary.Create; + + SettingsObj := JSONObj.GetValue('settings') as TJSONObject; + if Assigned(SettingsObj) then + begin + try + for Pair in SettingsObj do + begin + Key := Pair.JsonString.Value; + with SettingItem do + begin + image_file_name := SettingsObj.GetValue(Key).GetValue('imagefilename'); + + FilePath := SettingsObj.GetValue(Key).GetValue('path'); + tool_tip := SettingsObj.GetValue(Key).GetValue('tooltip'); + Is_path_valid := true; + memory_image := nil; + + end; + MySettings.Settings.TryAdd(Key, SettingItem); + end; + except + + end; + end; + + // Parse config + ConfigObj := JSONObj.GetValue('config') as TJSONObject; + if Assigned(ConfigObj) then + begin + with MySettings.Config do + begin + Left := ConfigObj.GetValue('left').Value.ToInteger; + Top := ConfigObj.GetValue('top').Value.ToInteger; + nodesize := ConfigObj.GetValue('nodesize').Value.ToInteger; + Shortcut := ConfigObj.GetValue('shortcut').Value; + translator := ConfigObj.GetValue('translator').Value; + debug := ConfigObj.GetValue('debug').Value; + end; + end; + + // Parse exclusion + ExclusionObj := JSONObj.GetValue('exclusion') as TJSONObject; + if Assigned(ExclusionObj) then + begin + MySettings.Exclusion.Value := ExclusionObj.GetValue('value').Value; + end; + +end; + +end. + diff --git a/sqlite/SQLite3.pas b/sqlite/SQLite3.pas deleted file mode 100644 index d7d61ca..0000000 --- a/sqlite/SQLite3.pas +++ /dev/null @@ -1,260 +0,0 @@ -unit SQLite3; - -{ - Simplified interface for SQLite. - Updated for Sqlite 3 by Tim Anderson (tim@itwriting.com) - Note: NOT COMPLETE for version 3, just minimal functionality - Adapted from file created by Pablo Pissanetzky (pablo@myhtpc.net) - which was based on SQLite.pas by Ben Hochstrasser (bhoc@surfeu.ch) -} - -{$IFDEF FPC} - {$MODE DELPHI} - {$H+} (* use AnsiString *) - {$PACKENUM 4} (* use 4-byte enums *) - {$PACKRECORDS C} (* C/C++-compatible record packing *) -{$ELSE} - {$MINENUMSIZE 4} (* use 4-byte enums *) -{$ENDIF} - -interface - -const -{$IF Defined(MSWINDOWS)} - SQLiteDLL = 'sqlite3.dll'; -{$ELSEIF Defined(DARWIN)} - SQLiteDLL = 'libsqlite3.dylib'; - {$linklib libsqlite3} -{$ELSEIF Defined(UNIX)} - SQLiteDLL = 'sqlite3.so'; -{$IFEND} - -// Return values for sqlite3_exec() and sqlite3_step() - -const - SQLITE_OK = 0; // Successful result - (* beginning-of-error-codes *) - SQLITE_ERROR = 1; // SQL error or missing database - SQLITE_INTERNAL = 2; // An internal logic error in SQLite - SQLITE_PERM = 3; // Access permission denied - SQLITE_ABORT = 4; // Callback routine requested an abort - SQLITE_BUSY = 5; // The database file is locked - SQLITE_LOCKED = 6; // A table in the database is locked - SQLITE_NOMEM = 7; // A malloc() failed - SQLITE_READONLY = 8; // Attempt to write a readonly database - SQLITE_INTERRUPT = 9; // Operation terminated by sqlite3_interrupt() - SQLITE_IOERR = 10; // Some kind of disk I/O error occurred - SQLITE_CORRUPT = 11; // The database disk image is malformed - SQLITE_NOTFOUND = 12; // (Internal Only) Table or record not found - SQLITE_FULL = 13; // Insertion failed because database is full - SQLITE_CANTOPEN = 14; // Unable to open the database file - SQLITE_PROTOCOL = 15; // Database lock protocol error - SQLITE_EMPTY = 16; // Database is empty - SQLITE_SCHEMA = 17; // The database schema changed - SQLITE_TOOBIG = 18; // Too much data for one row of a table - SQLITE_CONSTRAINT = 19; // Abort due to contraint violation - SQLITE_MISMATCH = 20; // Data type mismatch - SQLITE_MISUSE = 21; // Library used incorrectly - SQLITE_NOLFS = 22; // Uses OS features not supported on host - SQLITE_AUTH = 23; // Authorization denied - SQLITE_FORMAT = 24; // Auxiliary database format error - SQLITE_RANGE = 25; // 2nd parameter to sqlite3_bind out of range - SQLITE_NOTADB = 26; // File opened that is not a database file - SQLITE_ROW = 100; // sqlite3_step() has another row ready - SQLITE_DONE = 101; // sqlite3_step() has finished executing - - SQLITE_INTEGER = 1; - SQLITE_FLOAT = 2; - SQLITE_TEXT = 3; - SQLITE_BLOB = 4; - SQLITE_NULL = 5; - - SQLITE_UTF8 = 1; - SQLITE_UTF16 = 2; - SQLITE_UTF16BE = 3; - SQLITE_UTF16LE = 4; - SQLITE_ANY = 5; - - SQLITE_STATIC {: TSQLite3Destructor} = Pointer(0); - SQLITE_TRANSIENT {: TSQLite3Destructor} = Pointer(-1); - -type - TSQLiteDB = Pointer; - TSQLiteResult = ^PAnsiChar; - TSQLiteStmt = Pointer; - TSQLiteBackup = pointer; - -type - PPAnsiCharArray = ^TPAnsiCharArray; - TPAnsiCharArray = array[0 .. (MaxInt div SizeOf(PAnsiChar))-1] of PAnsiChar; - -type - TSQLiteExecCallback = function(UserData: Pointer; NumCols: integer; ColValues: - PPAnsiCharArray; ColNames: PPAnsiCharArray): integer; cdecl; - TSQLiteBusyHandlerCallback = function(UserData: Pointer; P2: integer): integer; cdecl; - - //function prototype for define own collate - TCollateXCompare = function(UserData: pointer; Buf1Len: integer; Buf1: pointer; - Buf2Len: integer; Buf2: pointer): integer; cdecl; - - -function SQLite3_Open(filename: PAnsiChar; var db: TSQLiteDB): integer; cdecl; external SQLiteDLL name 'sqlite3_open'; -function SQLite3_Close(db: TSQLiteDB): integer; cdecl; external SQLiteDLL name 'sqlite3_close'; -function SQLite3_Exec(db: TSQLiteDB; SQLStatement: PAnsiChar; CallbackPtr: TSQLiteExecCallback; UserData: Pointer; var ErrMsg: PAnsiChar): integer; cdecl; external SQLiteDLL name 'sqlite3_exec'; -function SQLite3_Version(): PAnsiChar; cdecl; external SQLiteDLL name 'sqlite3_libversion'; -function SQLite3_ErrMsg(db: TSQLiteDB): PAnsiChar; cdecl; external SQLiteDLL name 'sqlite3_errmsg'; -function SQLite3_ErrCode(db: TSQLiteDB): integer; cdecl; external SQLiteDLL name 'sqlite3_errcode'; -procedure SQlite3_Free(P: PAnsiChar); cdecl; external SQLiteDLL name 'sqlite3_free'; -function SQLite3_GetTable(db: TSQLiteDB; SQLStatement: PAnsiChar; var ResultPtr: TSQLiteResult; var RowCount: Cardinal; var ColCount: Cardinal; var ErrMsg: PAnsiChar): integer; cdecl; external SQLiteDLL name 'sqlite3_get_table'; -procedure SQLite3_FreeTable(Table: TSQLiteResult); cdecl; external SQLiteDLL name 'sqlite3_free_table'; -function SQLite3_Complete(P: PAnsiChar): boolean; cdecl; external SQLiteDLL name 'sqlite3_complete'; -function SQLite3_LastInsertRowID(db: TSQLiteDB): int64; cdecl; external SQLiteDLL name 'sqlite3_last_insert_rowid'; -procedure SQLite3_Interrupt(db: TSQLiteDB); cdecl; external SQLiteDLL name 'sqlite3_interrupt'; -procedure SQLite3_BusyHandler(db: TSQLiteDB; CallbackPtr: TSQLiteBusyHandlerCallback; UserData: Pointer); cdecl; external SQLiteDLL name 'sqlite3_busy_handler'; -procedure SQLite3_BusyTimeout(db: TSQLiteDB; TimeOut: integer); cdecl; external SQLiteDLL name 'sqlite3_busy_timeout'; -function SQLite3_Changes(db: TSQLiteDB): integer; cdecl; external SQLiteDLL name 'sqlite3_changes'; -function SQLite3_TotalChanges(db: TSQLiteDB): integer; cdecl; external SQLiteDLL name 'sqlite3_total_changes'; -function SQLite3_Prepare(db: TSQLiteDB; SQLStatement: PAnsiChar; nBytes: integer; var hStmt: TSqliteStmt; var pzTail: PAnsiChar): integer; cdecl; external SQLiteDLL name 'sqlite3_prepare'; -function SQLite3_Prepare_v2(db: TSQLiteDB; SQLStatement: PAnsiChar; nBytes: integer; var hStmt: TSqliteStmt; var pzTail: PAnsiChar): integer; cdecl; external SQLiteDLL name 'sqlite3_prepare_v2'; -function SQLite3_ColumnCount(hStmt: TSqliteStmt): integer; cdecl; external SQLiteDLL name 'sqlite3_column_count'; -function SQLite3_ColumnName(hStmt: TSqliteStmt; ColNum: integer): PAnsiChar; cdecl; external SQLiteDLL name 'sqlite3_column_name'; -function SQLite3_ColumnDeclType(hStmt: TSqliteStmt; ColNum: integer): PAnsiChar; cdecl; external SQLiteDLL name 'sqlite3_column_decltype'; -function SQLite3_Step(hStmt: TSqliteStmt): integer; cdecl; external SQLiteDLL name 'sqlite3_step'; -function SQLite3_DataCount(hStmt: TSqliteStmt): integer; cdecl; external SQLiteDLL name 'sqlite3_data_count'; - -function SQLite3_ColumnBlob(hStmt: TSqliteStmt; ColNum: integer): pointer; cdecl; external SQLiteDLL name 'sqlite3_column_blob'; -function SQLite3_ColumnBytes(hStmt: TSqliteStmt; ColNum: integer): integer; cdecl; external SQLiteDLL name 'sqlite3_column_bytes'; -function SQLite3_ColumnDouble(hStmt: TSqliteStmt; ColNum: integer): double; cdecl; external SQLiteDLL name 'sqlite3_column_double'; -function SQLite3_ColumnInt(hStmt: TSqliteStmt; ColNum: integer): integer; cdecl; external SQLiteDLL name 'sqlite3_column_int'; -function SQLite3_ColumnText(hStmt: TSqliteStmt; ColNum: integer): PAnsiChar; cdecl; external SQLiteDLL name 'sqlite3_column_text'; -function SQLite3_ColumnType(hStmt: TSqliteStmt; ColNum: integer): integer; cdecl; external SQLiteDLL name 'sqlite3_column_type'; -function SQLite3_ColumnInt64(hStmt: TSqliteStmt; ColNum: integer): Int64; cdecl; external SQLiteDLL name 'sqlite3_column_int64'; -function SQLite3_Finalize(hStmt: TSqliteStmt): integer; cdecl; external SQLiteDLL name 'sqlite3_finalize'; -function SQLite3_Reset(hStmt: TSqliteStmt): integer; cdecl; external SQLiteDLL name 'sqlite3_reset'; - -function SQLite3_Backup_Init(DestDb: TSQLiteDB; DestDbName: PAnsiChar; SourceDb: TSQLiteDB; SourceDbName: PAnsiChar): TSqliteBackup; cdecl; external SQLiteDLL name 'sqlite3_backup_init'; -function SQLite3_Backup_Step(hBackup: TSQLiteBackup; nPage: integer): integer; cdecl; external SQLiteDLL name 'sqlite3_backup_step'; -function SQLite3_Backup_Finish(hBackup: TSQLiteBackup): integer; cdecl; external SQLiteDLL name 'sqlite3_backup_finish'; -function SQLite3_Backup_Remaining(hBackup: TSQLiteBackup): integer; cdecl; external SQLiteDLL name 'sqlite3_backup_remaining'; -function SQLite3_Backup_Pagecount(hBackup: TSQLiteBackup): integer; cdecl; external SQLiteDLL name 'sqlite3_backup_pagecount'; - -// -// In the SQL strings input to sqlite3_prepare() and sqlite3_prepare16(), -// one or more literals can be replace by a wildcard "?" or ":N:" where -// N is an integer. These value of these wildcard literals can be set -// using the routines listed below. -// -// In every case, the first parameter is a pointer to the sqlite3_stmt -// structure returned from sqlite3_prepare(). The second parameter is the -// index of the wildcard. The first "?" has an index of 1. ":N:" wildcards -// use the index N. -// -// The fifth parameter to sqlite3_bind_blob(), sqlite3_bind_text(), and -//sqlite3_bind_text16() is a destructor used to dispose of the BLOB or -//text after SQLite has finished with it. If the fifth argument is the -// special value SQLITE_STATIC, then the library assumes that the information -// is in static, unmanaged space and does not need to be freed. If the -// fifth argument has the value SQLITE_TRANSIENT, then SQLite makes its -// own private copy of the data. -// -// The sqlite3_bind_* routine must be called before sqlite3_step() after -// an sqlite3_prepare() or sqlite3_reset(). Unbound wildcards are interpreted -// as NULL. -// - -type - TSQLite3Destructor = procedure(Ptr: Pointer); cdecl; - -function sqlite3_bind_blob(hStmt: TSqliteStmt; ParamNum: integer; - ptrData: pointer; numBytes: integer; ptrDestructor: TSQLite3Destructor): integer; -cdecl; external SQLiteDLL name 'sqlite3_bind_blob'; -function sqlite3_bind_text(hStmt: TSqliteStmt; ParamNum: integer; - Text: PAnsiChar; numBytes: integer; ptrDestructor: TSQLite3Destructor): integer; -cdecl; external SQLiteDLL name 'sqlite3_bind_text'; -function sqlite3_bind_double(hStmt: TSqliteStmt; ParamNum: integer; Data: Double): integer; - cdecl; external SQLiteDLL name 'sqlite3_bind_double'; -function sqlite3_bind_int(hStmt: TSqLiteStmt; ParamNum: integer; Data: integer): integer; - cdecl; external SQLiteDLL name 'sqlite3_bind_int'; -function sqlite3_bind_int64(hStmt: TSqliteStmt; ParamNum: integer; Data: int64): integer; - cdecl; external SQLiteDLL name 'sqlite3_bind_int64'; -function sqlite3_bind_null(hStmt: TSqliteStmt; ParamNum: integer): integer; - cdecl; external SQLiteDLL name 'sqlite3_bind_null'; - -function sqlite3_bind_parameter_index(hStmt: TSqliteStmt; zName: PAnsiChar): integer; - cdecl; external SQLiteDLL name 'sqlite3_bind_parameter_index'; - -function sqlite3_enable_shared_cache(Value: integer): integer; cdecl; external SQLiteDLL name 'sqlite3_enable_shared_cache'; - -//user collate definiton -function SQLite3_create_collation(db: TSQLiteDB; Name: PAnsiChar; eTextRep: integer; - UserData: pointer; xCompare: TCollateXCompare): integer; cdecl; external SQLiteDLL name 'sqlite3_create_collation'; - -function SQLiteFieldType(SQLiteFieldTypeCode: Integer): AnsiString; -function SQLiteErrorStr(SQLiteErrorCode: Integer): AnsiString; - -implementation - -uses - SysUtils; - -function SQLiteFieldType(SQLiteFieldTypeCode: Integer): AnsiString; -begin - case SQLiteFieldTypeCode of - SQLITE_INTEGER: Result := 'Integer'; - SQLITE_FLOAT: Result := 'Float'; - SQLITE_TEXT: Result := 'Text'; - SQLITE_BLOB: Result := 'Blob'; - SQLITE_NULL: Result := 'Null'; - else - Result := 'Unknown SQLite Field Type Code "' + IntToStr(SQLiteFieldTypeCode) + '"'; - end; -end; - -function SQLiteErrorStr(SQLiteErrorCode: Integer): AnsiString; -begin - case SQLiteErrorCode of - SQLITE_OK: Result := 'Successful result'; - SQLITE_ERROR: Result := 'SQL error or missing database'; - SQLITE_INTERNAL: Result := 'An internal logic error in SQLite'; - SQLITE_PERM: Result := 'Access permission denied'; - SQLITE_ABORT: Result := 'Callback routine requested an abort'; - SQLITE_BUSY: Result := 'The database file is locked'; - SQLITE_LOCKED: Result := 'A table in the database is locked'; - SQLITE_NOMEM: Result := 'A malloc() failed'; - SQLITE_READONLY: Result := 'Attempt to write a readonly database'; - SQLITE_INTERRUPT: Result := 'Operation terminated by sqlite3_interrupt()'; - SQLITE_IOERR: Result := 'Some kind of disk I/O error occurred'; - SQLITE_CORRUPT: Result := 'The database disk image is malformed'; - SQLITE_NOTFOUND: Result := '(Internal Only) Table or record not found'; - SQLITE_FULL: Result := 'Insertion failed because database is full'; - SQLITE_CANTOPEN: Result := 'Unable to open the database file'; - SQLITE_PROTOCOL: Result := 'Database lock protocol error'; - SQLITE_EMPTY: Result := 'Database is empty'; - SQLITE_SCHEMA: Result := 'The database schema changed'; - SQLITE_TOOBIG: Result := 'Too much data for one row of a table'; - SQLITE_CONSTRAINT: Result := 'Abort due to contraint violation'; - SQLITE_MISMATCH: Result := 'Data type mismatch'; - SQLITE_MISUSE: Result := 'Library used incorrectly'; - SQLITE_NOLFS: Result := 'Uses OS features not supported on host'; - SQLITE_AUTH: Result := 'Authorization denied'; - SQLITE_FORMAT: Result := 'Auxiliary database format error'; - SQLITE_RANGE: Result := '2nd parameter to sqlite3_bind out of range'; - SQLITE_NOTADB: Result := 'File opened that is not a database file'; - SQLITE_ROW: Result := 'sqlite3_step() has another row ready'; - SQLITE_DONE: Result := 'sqlite3_step() has finished executing'; - else - Result := 'Unknown SQLite Error Code "' + IntToStr(SQLiteErrorCode) + '"'; - end; -end; - -function ColValueToStr(Value: PAnsiChar): AnsiString; -begin - if (Value = nil) then - Result := 'NULL' - else - Result := Value; -end; - - -end. - diff --git a/sqlite/SQLiteTable3.pas b/sqlite/SQLiteTable3.pas deleted file mode 100644 index f1ec29d..0000000 --- a/sqlite/SQLiteTable3.pas +++ /dev/null @@ -1,1519 +0,0 @@ -unit SQLiteTable3; - -{ - Simple classes for using SQLite's exec and get_table. - - TSQLiteDatabase wraps the calls to open and close an SQLite database. - It also wraps SQLite_exec for queries that do not return a result set - - TSQLiteTable wraps execution of SQL query. - It run query and read all returned rows to internal buffer. - It allows accessing fields by name as well as index and can move through a - result set forward and backwards, or randomly to any row. - - TSQLiteUniTable wraps execution of SQL query. - It run query as TSQLiteTable, but reading just first row only! - You can step to next row (until not EOF) by 'Next' method. - You cannot step backwards! (So, it is called as UniDirectional result set.) - It not using any internal buffering, this class is very close to Sqlite API. - It allows accessing fields by name as well as index on actual row only. - Very good and fast for sequentional scanning of large result sets with minimal - memory footprint. - - Warning! Do not close TSQLiteDatabase before any TSQLiteUniTable, - because query is closed on TSQLiteUniTable destructor and database connection - is used during TSQLiteUniTable live! - - SQL parameter usage: - You can add named parameter values by call set of AddParam* methods. - Parameters will be used for first next SQL statement only. - Parameter name must be prefixed by ':', '$' or '@' and same prefix must be - used in SQL statement! - Sample: - table.AddParamText(':str', 'some value'); - s := table.GetTableString('SELECT value FROM sometable WHERE id=:str'); - - Notes from Andrew Retmanski on prepared queries - The changes are as follows: - - SQLiteTable3.pas - - Added new boolean property Synchronised (this controls the SYNCHRONOUS pragma as I found that turning this OFF increased the write performance in my application) - - Added new type TSQLiteQuery (this is just a simple record wrapper around the SQL ansiString and a TSQLiteStmt pointer) - - Added PrepareSQL method to prepare SQL query - returns TSQLiteQuery - - Added ReleaseSQL method to release previously prepared query - - Added overloaded BindSQL methods for Integer and ansiString types - these set new values for the prepared query parameters - - Added overloaded ExecSQL method to execute a prepared TSQLiteQuery - - Usage of the new methods should be self explanatory but the process is in essence: - - 1. Call PrepareSQL to return TSQLiteQuery 2. Call BindSQL for each parameter in the prepared query 3. Call ExecSQL to run the prepared query 4. Repeat steps 2 & 3 as required 5. Call ReleaseSQL to free SQLite resources - - One other point - the Synchronised property throws an error if used inside a transaction. - - Acknowledments - Adapted by Tim Anderson (tim@itwriting.com) - Originally created by Pablo Pissanetzky (pablo@myhtpc.net) - Modified and enhanced by Lukas Gebauer - Modified and enhanced by Tobias Gunkel -} - -interface - -{$IFDEF FPC} - {$MODE Delphi}{$H+} -{$ENDIF} - -uses - {$IFDEF WIN32} - Windows, - {$ENDIF} - SQLite3, Classes, SysUtils; - -const - - dtInt = 1; - dtNumeric = 2; - dtStr = 3; - dtBlob = 4; - dtNull = 5; - -type - - ESQLiteException = class(Exception) - end; - - TSQliteParam = class - public - name: ansiString; - valuetype: integer; - valueinteger: int64; - valuefloat: double; - valuedata: ansiString; - end; - - THookQuery = procedure(Sender: TObject; SQL: ansiString) of object; - - TSQLiteQuery = record - SQL: ansiString; - Statement: TSQLiteStmt; - end; - - TSQLiteTable = class; - TSQLiteUniTable = class; - - TSQLiteDatabase = class - private - fDB: TSQLiteDB; - fInTrans: boolean; - fSync: boolean; - fParams: TList; - FOnQuery: THookQuery; - procedure RaiseError(s: ansiString; SQL: ansiString); - procedure SetParams(Stmt: TSQLiteStmt); - procedure BindData(Stmt: TSQLiteStmt; const Bindings: array of const); - function GetRowsChanged: integer; - protected - procedure SetSynchronised(Value: boolean); - procedure DoQuery(value: ansiString); - public - constructor Create(const FileName: String); - destructor Destroy; override; - function GetTable(const SQL: Ansistring): TSQLiteTable; overload; - function GetTable(const SQL: Ansistring; const Bindings: array of const): TSQLiteTable; overload; - procedure ExecSQL(const SQL: Ansistring); overload; - procedure ExecSQL(const SQL: Ansistring; const Bindings: array of const); overload; - procedure ExecSQL(Query: TSQLiteQuery); overload; - function PrepareSQL(const SQL: Ansistring): TSQLiteQuery; - procedure BindSQL(Query: TSQLiteQuery; const Index: Integer; const Value: Integer); overload; - procedure BindSQL(Query: TSQLiteQuery; const Index: Integer; const Value: ansiString); overload; - procedure ReleaseSQL(Query: TSQLiteQuery); - function GetUniTable(const SQL: Ansistring): TSQLiteUniTable; overload; - function GetUniTable(const SQL: Ansistring; const Bindings: array of const): TSQLiteUniTable; overload; - function GetTableValue(const SQL: Ansistring): int64; overload; - function GetTableValue(const SQL: Ansistring; const Bindings: array of const): int64; overload; - function GetTableString(const SQL: Ansistring): ansiString; overload; - function GetTableString(const SQL: Ansistring; const Bindings: array of const): ansiString; overload; - procedure GetTableStrings(const SQL: Ansistring; const Value: TStrings); - procedure UpdateBlob(const SQL: Ansistring; BlobData: TStream); - procedure BeginTransaction; - procedure Commit; - procedure Rollback; - function TableExists(TableName: ansiString): boolean; - function GetLastInsertRowID: int64; - function GetLastChangedRows: int64; - procedure SetTimeout(Value: integer); - function Backup(TargetDB: TSQLiteDatabase): integer; Overload; - function Backup(TargetDB: TSQLiteDatabase; targetName: Ansistring; sourceName: Ansistring): integer; Overload; - function Version: ansiString; - procedure AddCustomCollate(name: ansiString; xCompare: TCollateXCompare); - //adds collate named SYSTEM for correct data sorting by user's locale - Procedure AddSystemCollate; - procedure ParamsClear; - procedure AddParamInt(name: ansiString; value: int64); - procedure AddParamFloat(name: ansiString; value: double); - procedure AddParamText(name: ansiString; value: ansiString); - procedure AddParamNull(name: ansiString); - - property DB: TSQLiteDB read fDB; - published - property IsTransactionOpen: boolean read fInTrans; - //database rows that were changed (or inserted or deleted) by the most recent SQL statement - property RowsChanged : integer read getRowsChanged; - property Synchronised: boolean read FSync write SetSynchronised; - property OnQuery: THookQuery read FOnQuery write FOnQuery; - end; - - TSQLiteTable = class - private - fResults: TList; - fRowCount: cardinal; - fColCount: cardinal; - fCols: TStringList; - fColTypes: TList; - fRow: cardinal; - function GetFields(I: cardinal): ansiString; - function GetEOF: boolean; - function GetBOF: boolean; - function GetColumns(I: integer): ansiString; - function GetFieldByName(FieldName: ansiString): ansiString; - function GetFieldIndex(FieldName: ansiString): integer; - function GetCount: integer; - function GetCountResult: integer; - public - constructor Create(DB: TSQLiteDatabase; const SQL: Ansistring); overload; - constructor Create(DB: TSQLiteDatabase; const SQL: Ansistring; const Bindings: array of const); overload; - destructor Destroy; override; - function FieldAsInteger(I: cardinal): int64; - function FieldAsBlob(I: cardinal): TMemoryStream; - function FieldAsBlobText(I: cardinal): ansiString; - function FieldIsNull(I: cardinal): boolean; - function FieldAsString(I: cardinal): ansiString; - function FieldAsDouble(I: cardinal): double; - function Next: boolean; - function Previous: boolean; - property EOF: boolean read GetEOF; - property BOF: boolean read GetBOF; - property Fields[I: cardinal]: ansiString read GetFields; - property FieldByName[FieldName: ansiString]: ansiString read GetFieldByName; - property FieldIndex[FieldName: ansiString]: integer read GetFieldIndex; - property Columns[I: integer]: ansiString read GetColumns; - property ColCount: cardinal read fColCount; - property RowCount: cardinal read fRowCount; - property Row: cardinal read fRow; - function MoveFirst: boolean; - function MoveLast: boolean; - function MoveTo(position: cardinal): boolean; - property Count: integer read GetCount; - // The property CountResult is used when you execute count(*) queries. - // It returns 0 if the result set is empty or the value of the - // first field as an integer. - property CountResult: integer read GetCountResult; - end; - - TSQLiteUniTable = class - private - fColCount: cardinal; - fCols: TStringList; - fRow: cardinal; - fEOF: boolean; - fStmt: TSQLiteStmt; - fDB: TSQLiteDatabase; - fSQL: ansiString; - function GetFields(I: cardinal): ansiString; - function GetColumns(I: integer): ansiString; - function GetFieldByName(FieldName: ansiString): ansiString; - function GetFieldIndex(FieldName: ansiString): integer; - public - constructor Create(DB: TSQLiteDatabase; const SQL: Ansistring); overload; - constructor Create(DB: TSQLiteDatabase; const SQL: Ansistring; const Bindings: array of const); overload; - destructor Destroy; override; - function FieldAsInteger(I: cardinal): int64; - function FieldAsBlob(I: cardinal): TMemoryStream; - function FieldAsBlobPtr(I: cardinal; out iNumBytes: integer): Pointer; - function FieldAsBlobText(I: cardinal): ansiString; - function FieldIsNull(I: cardinal): boolean; - function FieldAsString(I: cardinal): ansiString; - function FieldAsDouble(I: cardinal): double; - function Next: boolean; - property EOF: boolean read FEOF; - property Fields[I: cardinal]: ansiString read GetFields; - property FieldByName[FieldName: ansiString]: ansiString read GetFieldByName; - property FieldIndex[FieldName: ansiString]: integer read GetFieldIndex; - property Columns[I: integer]: ansiString read GetColumns; - property ColCount: cardinal read fColCount; - property Row: cardinal read fRow; - end; - var - global_table: TSQLiteTable; -procedure DisposePointer(ptr: pointer); cdecl; - -{$IFDEF WIN32} -function SystemCollate(Userdta: pointer; Buf1Len: integer; Buf1: pointer; - Buf2Len: integer; Buf2: pointer): integer; cdecl; -{$ENDIF} - -implementation - -procedure DisposePointer(ptr: pointer); cdecl; -begin - if assigned(ptr) then - freemem(ptr); -end; - -{$IFDEF WIN32} -function SystemCollate(Userdta: pointer; Buf1Len: integer; Buf1: pointer; - Buf2Len: integer; Buf2: pointer): integer; cdecl; -begin - Result := CompareStringW(LOCALE_USER_DEFAULT, 0, PWideChar(Buf1), Buf1Len, - PWideChar(Buf2), Buf2Len) - 2; -end; -{$ENDIF} - -//------------------------------------------------------------------------------ -// TSQLiteDatabase -//------------------------------------------------------------------------------ - -constructor TSQLiteDatabase.Create(const FileName: String); -var - Msg: PAnsiChar; - iResult: integer; - utf8FileName: UTF8string; -begin - inherited Create; - fParams := TList.Create; - - self.fInTrans := False; - - Msg := nil; - try - utf8FileName := UTF8String(FileName); - iResult := SQLite3_Open(PAnsiChar(utf8FileName), Fdb); - - if iResult <> SQLITE_OK then - if Assigned(Fdb) then - begin - Msg := Sqlite3_ErrMsg(Fdb); - raise ESqliteException.CreateFmt('Failed to open database "%s" : %s', - [FileName, Msg]); - end - else - raise ESqliteException.CreateFmt('Failed to open database "%s" : unknown error', - [FileName]); - -//set a few configs -//L.G. Do not call it here. Because busy handler is not setted here, -// any share violation causing exception! - -// self.ExecSQL('PRAGMA SYNCHRONOUS=NORMAL;'); -// self.ExecSQL('PRAGMA temp_store = MEMORY;'); - - finally - if Assigned(Msg) then - SQLite3_Free(Msg); - end; - -end; - -//.............................................................................. - -destructor TSQLiteDatabase.Destroy; -begin - if self.fInTrans then - self.Rollback; //assume rollback - if Assigned(fDB) then - SQLite3_Close(fDB); - ParamsClear; - fParams.Free; - inherited; -end; - -function TSQLiteDatabase.GetLastInsertRowID: int64; -begin - Result := Sqlite3_LastInsertRowID(self.fDB); -end; - -function TSQLiteDatabase.GetLastChangedRows: int64; -begin - Result := SQLite3_TotalChanges(self.fDB); -end; - -//.............................................................................. - -procedure TSQLiteDatabase.RaiseError(s: ansiString; SQL: ansiString); -//look up last error and raise an exception with an appropriate message -var - Msg: PAnsiChar; - ret : integer; -begin - - Msg := nil; - - ret := sqlite3_errcode(self.fDB); - if ret <> SQLITE_OK then - Msg := sqlite3_errmsg(self.fDB); - - if Msg <> nil then - raise ESqliteException.CreateFmt(s +'.'#13'Error [%d]: %s.'#13'"%s": %s', [ret, SQLiteErrorStr(ret),SQL, Msg]) - else - raise ESqliteException.CreateFmt(s, [SQL, 'No message']); - -end; - -procedure TSQLiteDatabase.SetSynchronised(Value: boolean); -begin - if Value <> fSync then - begin - if Value then - ExecSQL('PRAGMA synchronous = ON;') - else - ExecSQL('PRAGMA synchronous = OFF;'); - fSync := Value; - end; -end; - -procedure TSQLiteDatabase.BindData(Stmt: TSQLiteStmt; const Bindings: array of const); -var - BlobMemStream: TCustomMemoryStream; - BlobStdStream: TStream; - DataPtr: Pointer; - DataSize: integer; - AnsiStr: AnsiString; - AnsiStrPtr: PAnsiString; - I: integer; -begin - for I := 0 to High(Bindings) do - begin - case Bindings[I].VType of - vtString, - vtAnsiString, vtPChar, - vtWideString, vtPWideChar, - vtChar, vtWideChar: - begin - case Bindings[I].VType of - vtString: begin // ShortString - AnsiStr := Bindings[I].VString^; - DataPtr := PAnsiChar(AnsiStr); - DataSize := Length(AnsiStr)+1; - end; - vtPChar: begin - DataPtr := Bindings[I].VPChar; - DataSize := -1; - end; - vtAnsiString: begin - AnsiStrPtr := PAnsiString(@Bindings[I].VAnsiString); - DataPtr := PAnsiChar(AnsiStrPtr^); - DataSize := Length(AnsiStrPtr^)+1; - end; - vtPWideChar: begin - DataPtr := PAnsiChar(UTF8Encode(WideString(Bindings[I].VPWideChar))); - DataSize := -1; - end; - vtWideString: begin - DataPtr := PAnsiChar(UTF8Encode(PWideString(@Bindings[I].VWideString)^)); - DataSize := -1; - end; - vtChar: begin - DataPtr := PAnsiChar(ansiString(Bindings[I].VChar)); - DataSize := 2; - end; - vtWideChar: begin - DataPtr := PAnsiChar(UTF8Encode(WideString(Bindings[I].VWideChar))); - DataSize := -1; - end; - else - raise ESqliteException.Create('Unknown string-type'); - end; - if (sqlite3_bind_text(Stmt, I+1, DataPtr, DataSize, SQLITE_STATIC) <> SQLITE_OK) then - RaiseError('Could not bind text', 'BindData'); - end; - vtInteger: - if (sqlite3_bind_int(Stmt, I+1, Bindings[I].VInteger) <> SQLITE_OK) then - RaiseError('Could not bind integer', 'BindData'); - vtInt64: - if (sqlite3_bind_int64(Stmt, I+1, Bindings[I].VInt64^) <> SQLITE_OK) then - RaiseError('Could not bind int64', 'BindData'); - vtExtended: - if (sqlite3_bind_double(Stmt, I+1, Bindings[I].VExtended^) <> SQLITE_OK) then - RaiseError('Could not bind extended', 'BindData'); - vtBoolean: - if (sqlite3_bind_int(Stmt, I+1, Integer(Bindings[I].VBoolean)) <> SQLITE_OK) then - RaiseError('Could not bind boolean', 'BindData'); - vtPointer: - begin - if (Bindings[I].VPointer = nil) then - begin - if (sqlite3_bind_null(Stmt, I+1) <> SQLITE_OK) then - RaiseError('Could not bind null', 'BindData'); - end - else - raise ESqliteException.Create('Unhandled pointer (<> nil)'); - end; - vtObject: - begin - if (Bindings[I].VObject is TCustomMemoryStream) then - begin - BlobMemStream := TCustomMemoryStream(Bindings[I].VObject); - if (sqlite3_bind_blob(Stmt, I+1, @PAnsiChar(BlobMemStream.Memory)[BlobMemStream.Position], - BlobMemStream.Size-BlobMemStream.Position, SQLITE_STATIC) <> SQLITE_OK) then - begin - RaiseError('Could not bind BLOB', 'BindData'); - end; - end - else if (Bindings[I].VObject is TStream) then - begin - BlobStdStream := TStream(Bindings[I].VObject); - DataSize := BlobStdStream.Size; - - GetMem(DataPtr, DataSize); - if (DataPtr = nil) then - raise ESqliteException.Create('Error getting memory to save blob'); - - BlobStdStream.Position := 0; - BlobStdStream.Read(DataPtr^, DataSize); - - if (sqlite3_bind_blob(stmt, I+1, DataPtr, DataSize, @DisposePointer) <> SQLITE_OK) then - RaiseError('Could not bind BLOB', 'BindData'); - end - else - raise ESqliteException.Create('Unhandled object-type in binding'); - end - else - begin - raise ESqliteException.Create('Unhandled binding'); - end; - end; - end; -end; - -procedure TSQLiteDatabase.ExecSQL(const SQL: Ansistring); -begin - ExecSQL(SQL, []); -end; - -procedure TSQLiteDatabase.ExecSQL(const SQL: Ansistring; const Bindings: array of const); -var - Stmt: TSQLiteStmt; - NextSQLStatement: PAnsiChar; - iStepResult: integer; -begin - try - if Sqlite3_Prepare_v2(self.fDB, PAnsiChar(SQL), -1, Stmt, NextSQLStatement) <> - SQLITE_OK then - RaiseError('Error executing SQL', SQL); - if (Stmt = nil) then - RaiseError('Could not prepare SQL statement', SQL); - DoQuery(SQL); - SetParams(Stmt); - BindData(Stmt, Bindings); - - iStepResult := Sqlite3_step(Stmt); - if (iStepResult <> SQLITE_DONE) then - begin - SQLite3_reset(stmt); - RaiseError('Error executing SQL statement', SQL); - end; - finally - if Assigned(Stmt) then - Sqlite3_Finalize(stmt); - end; -end; - -{$WARNINGS OFF} -procedure TSQLiteDatabase.ExecSQL(Query: TSQLiteQuery); -var - iStepResult: integer; -begin - if Assigned(Query.Statement) then - begin - iStepResult := Sqlite3_step(Query.Statement); - - if (iStepResult <> SQLITE_DONE) then - begin - SQLite3_reset(Query.Statement); - RaiseError('Error executing prepared SQL statement', Query.SQL); - end; - Sqlite3_Reset(Query.Statement); - end; -end; -{$WARNINGS ON} - -{$WARNINGS OFF} -function TSQLiteDatabase.PrepareSQL(const SQL: Ansistring): TSQLiteQuery; -var - Stmt: TSQLiteStmt; - NextSQLStatement: PAnsiChar; -begin - Result.SQL := SQL; - Result.Statement := nil; - - if Sqlite3_Prepare(self.fDB, PAnsiChar(SQL), -1, Stmt, NextSQLStatement) <> - SQLITE_OK then - RaiseError('Error executing SQL', SQL) - else - Result.Statement := Stmt; - - if (Result.Statement = nil) then - RaiseError('Could not prepare SQL statement', SQL); - DoQuery(SQL); -end; -{$WARNINGS ON} - -{$WARNINGS OFF} -procedure TSQLiteDatabase.BindSQL(Query: TSQLiteQuery; const Index: Integer; const Value: Integer); -begin - if Assigned(Query.Statement) then - sqlite3_Bind_Int(Query.Statement, Index, Value) - else - RaiseError('Could not bind integer to prepared SQL statement', Query.SQL); -end; -{$WARNINGS ON} - -{$WARNINGS OFF} -procedure TSQLiteDatabase.BindSQL(Query: TSQLiteQuery; const Index: Integer; const Value: ansiString); -begin - if Assigned(Query.Statement) then - Sqlite3_Bind_Text(Query.Statement, Index, PAnsiChar(Value), Length(Value), Pointer(SQLITE_STATIC)) - else - RaiseError('Could not bind string to prepared SQL statement', Query.SQL); -end; -{$WARNINGS ON} - -{$WARNINGS OFF} -procedure TSQLiteDatabase.ReleaseSQL(Query: TSQLiteQuery); -begin - if Assigned(Query.Statement) then - begin - Sqlite3_Finalize(Query.Statement); - Query.Statement := nil; - end - else - RaiseError('Could not release prepared SQL statement', Query.SQL); -end; -{$WARNINGS ON} - -procedure TSQLiteDatabase.UpdateBlob(const SQL: Ansistring; BlobData: TStream); -var - iSize: integer; - ptr: pointer; - Stmt: TSQLiteStmt; - Msg: PAnsiChar; - NextSQLStatement: PAnsiChar; - iStepResult: integer; - iBindResult: integer; -begin - //expects SQL of the form 'UPDATE MYTABLE SET MYFIELD = ? WHERE MYKEY = 1' - if pos('?', SQL) = 0 then - RaiseError('SQL must include a ? parameter', SQL); - - Msg := nil; - try - - if Sqlite3_Prepare_v2(self.fDB, PAnsiChar(SQL), -1, Stmt, NextSQLStatement) <> - SQLITE_OK then - RaiseError('Could not prepare SQL statement', SQL); - - if (Stmt = nil) then - RaiseError('Could not prepare SQL statement', SQL); - DoQuery(SQL); - - //now bind the blob data - iSize := BlobData.size; - - GetMem(ptr, iSize); - - if (ptr = nil) then - raise ESqliteException.CreateFmt('Error getting memory to save blob', - [SQL, 'Error']); - - BlobData.position := 0; - BlobData.Read(ptr^, iSize); - - iBindResult := SQLite3_Bind_Blob(stmt, 1, ptr, iSize, @DisposePointer); - - if iBindResult <> SQLITE_OK then - RaiseError('Error binding blob to database', SQL); - - iStepResult := Sqlite3_step(Stmt); - - if (iStepResult <> SQLITE_DONE) then - begin - SQLite3_reset(stmt); - RaiseError('Error executing SQL statement', SQL); - end; - - finally - - if Assigned(Stmt) then - Sqlite3_Finalize(stmt); - - if Assigned(Msg) then - SQLite3_Free(Msg); - end; - -end; - -//.............................................................................. - -function TSQLiteDatabase.GetTable(const SQL: Ansistring): TSQLiteTable; -begin - - result := TSQLiteTable.Create(Self, SQL); - -end; - -function TSQLiteDatabase.GetTable(const SQL: Ansistring; const Bindings: array of const): TSQLiteTable; -begin - Result := TSQLiteTable.Create(Self, SQL, Bindings); -end; - -function TSQLiteDatabase.GetUniTable(const SQL: Ansistring): TSQLiteUniTable; -begin - Result := TSQLiteUniTable.Create(Self, SQL); -end; - -function TSQLiteDatabase.GetUniTable(const SQL: Ansistring; const Bindings: array of const): TSQLiteUniTable; -begin - Result := TSQLiteUniTable.Create(Self, SQL, Bindings); -end; - -function TSQLiteDatabase.GetTableValue(const SQL: Ansistring): int64; -begin - Result := GetTableValue(SQL, []); -end; - -function TSQLiteDatabase.GetTableValue(const SQL: Ansistring; const Bindings: array of const): int64; -var - Table: TSQLiteUniTable; -begin - Result := 0; - Table := self.GetUniTable(SQL, Bindings); - try - if not Table.EOF then - Result := Table.FieldAsInteger(0); - finally - Table.Free; - end; -end; - -function TSQLiteDatabase.GetTableString(const SQL: Ansistring): ansiString; -begin - Result := GetTableString(SQL, []); -end; - -function TSQLiteDatabase.GetTableString(const SQL: Ansistring; const Bindings: array of const): ansiString; -var - Table: TSQLiteUniTable; -begin - Result := ''; - Table := self.GetUniTable(SQL, Bindings); - try - if not Table.EOF then - Result := Table.FieldAsString(0); - finally - Table.Free; - end; -end; - -procedure TSQLiteDatabase.GetTableStrings(const SQL: Ansistring; - const Value: TStrings); -var - Table: TSQLiteUniTable; -begin - Value.Clear; - Table := self.GetUniTable(SQL); - try - while not table.EOF do - begin - Value.Add(Table.FieldAsString(0)); - table.Next; - end; - finally - Table.Free; - end; -end; - -procedure TSQLiteDatabase.BeginTransaction; -begin - if not self.fInTrans then - begin - self.ExecSQL('BEGIN TRANSACTION'); - self.fInTrans := True; - end - else - raise ESqliteException.Create('Transaction already open'); -end; - -procedure TSQLiteDatabase.Commit; -begin - self.ExecSQL('COMMIT'); - self.fInTrans := False; -end; - -procedure TSQLiteDatabase.Rollback; -begin - self.ExecSQL('ROLLBACK'); - self.fInTrans := False; -end; - -function TSQLiteDatabase.TableExists(TableName: ansiString): boolean; -var - sql: ansiString; - ds: TSqliteTable; -begin - //returns true if table exists in the database - sql := 'select [sql] from sqlite_master where [type] = ''table'' and lower(name) = ''' + - lowercase(TableName) + ''' '; - ds:= TSQLiteTable.Create(Self, SQL) ; -// ds := self.GetTable(sql); - try - Result := (ds.Count > 0); - finally - if ds<>nil then - FreeAndNil(ds); -// ds.Free; - end; -end; - -procedure TSQLiteDatabase.SetTimeout(Value: integer); -begin - SQLite3_BusyTimeout(self.fDB, Value); -end; - -function TSQLiteDatabase.Version: ansiString; -begin - Result := SQLite3_Version; -end; - -procedure TSQLiteDatabase.AddCustomCollate(name: ansiString; - xCompare: TCollateXCompare); -begin - sqlite3_create_collation(fdb, PAnsiChar(name), SQLITE_UTF8, nil, xCompare); -end; - -procedure TSQLiteDatabase.AddSystemCollate; -begin - {$IFDEF WIN32} - sqlite3_create_collation(fdb, 'SYSTEM', SQLITE_UTF16LE, nil, @SystemCollate); - {$ENDIF} -end; - -procedure TSQLiteDatabase.ParamsClear; -var - n: integer; -begin - for n := fParams.Count - 1 downto 0 do - TSQliteParam(fparams[n]).free; - fParams.Clear; -end; - -procedure TSQLiteDatabase.AddParamInt(name: ansiString; value: int64); -var - par: TSQliteParam; -begin - par := TSQliteParam.Create; - par.name := name; - par.valuetype := SQLITE_INTEGER; - par.valueinteger := value; - fParams.Add(par); -end; - -procedure TSQLiteDatabase.AddParamFloat(name: ansiString; value: double); -var - par: TSQliteParam; -begin - par := TSQliteParam.Create; - par.name := name; - par.valuetype := SQLITE_FLOAT; - par.valuefloat := value; - fParams.Add(par); -end; - -procedure TSQLiteDatabase.AddParamText(name: ansiString; value: ansiString); -var - par: TSQliteParam; -begin - par := TSQliteParam.Create; - par.name := name; - par.valuetype := SQLITE_TEXT; - par.valuedata := value; - fParams.Add(par); -end; - -procedure TSQLiteDatabase.AddParamNull(name: ansiString); -var - par: TSQliteParam; -begin - par := TSQliteParam.Create; - par.name := name; - par.valuetype := SQLITE_NULL; - fParams.Add(par); -end; - -procedure TSQLiteDatabase.SetParams(Stmt: TSQLiteStmt); -var - n: integer; - i: integer; - par: TSQliteParam; -begin - try - for n := 0 to fParams.Count - 1 do - begin - par := TSQliteParam(fParams[n]); - i := sqlite3_bind_parameter_index(Stmt, PAnsiChar(par.name)); - if i > 0 then - begin - case par.valuetype of - SQLITE_INTEGER: - sqlite3_bind_int64(Stmt, i, par.valueinteger); - SQLITE_FLOAT: - sqlite3_bind_double(Stmt, i, par.valuefloat); - SQLITE_TEXT: - sqlite3_bind_text(Stmt, i, PAnsiChar(par.valuedata), - length(par.valuedata), SQLITE_TRANSIENT); - SQLITE_NULL: - sqlite3_bind_null(Stmt, i); - end; - end; - end; - finally - ParamsClear; - end; -end; - -//database rows that were changed (or inserted or deleted) by the most recent SQL statement -function TSQLiteDatabase.GetRowsChanged: integer; -begin - Result := SQLite3_Changes(self.fDB); -end; - -procedure TSQLiteDatabase.DoQuery(value: ansiString); -begin - if assigned(OnQuery) then - OnQuery(Self, Value); -end; - -//returns result of SQLITE3_Backup_Step -function TSQLiteDatabase.Backup(TargetDB: TSQLiteDatabase; targetName: Ansistring; sourceName: Ansistring): integer; -var -pBackup: TSQLiteBackup; -begin - pBackup := Sqlite3_backup_init(TargetDB.DB,PAnsiChar(targetName),self.DB,PAnsiChar(sourceName)); - - if (pBackup = nil) then - raise ESqliteException.Create('Could not initialize backup') - else begin - try - result := SQLITE3_Backup_Step(pBackup,-1); //copies entire db - finally - SQLITE3_backup_finish(pBackup); - end; - end; -end; - -function TSQliteDatabase.Backup(TargetDB: TSQLiteDatabase): integer; -begin - result := self.Backup(TargetDB,'main','main'); -end; - -//------------------------------------------------------------------------------ -// TSQLiteTable -//------------------------------------------------------------------------------ - -constructor TSQLiteTable.Create(DB: TSQLiteDatabase; const SQL: Ansistring); -begin - Create(DB, SQL, []); -end; - -constructor TSQLiteTable.Create(DB: TSQLiteDatabase; const SQL: Ansistring; const Bindings: array of const); -var - Stmt: TSQLiteStmt; - NextSQLStatement: PAnsiChar; - iStepResult: integer; - ptr: pointer; - iNumBytes: integer; - thisBlobValue: TMemoryStream; - thisStringValue: pstring; - thisDoubleValue: pDouble; - thisIntValue: pInt64; - thisColType: pInteger; - i: integer; - DeclaredColType: PAnsiChar; - ActualColType: integer; - ptrValue: PAnsiChar; -begin - inherited create; - try - self.fRowCount := 0; - self.fColCount := 0; - //if there are several SQL statements in SQL, NextSQLStatment points to the - //beginning of the next one. Prepare only prepares the first SQL statement. - if Sqlite3_Prepare_v2(DB.fDB, PAnsiChar(SQL), -1, Stmt, NextSQLStatement) <> SQLITE_OK then - DB.RaiseError('Error executing SQL', SQL); - if (Stmt = nil) then - DB.RaiseError('Could not prepare SQL statement', SQL); - DB.DoQuery(SQL); - DB.SetParams(Stmt); - DB.BindData(Stmt, Bindings); - - iStepResult := Sqlite3_step(Stmt); - while (iStepResult <> SQLITE_DONE) do - begin - case iStepResult of - SQLITE_ROW: - begin - Inc(fRowCount); - if (fRowCount = 1) then - begin - //get data types - fCols := TStringList.Create; - fColTypes := TList.Create; - fColCount := SQLite3_ColumnCount(stmt); - for i := 0 to Pred(fColCount) do - fCols.Add(AnsiUpperCase(Sqlite3_ColumnName(stmt, i))); - for i := 0 to Pred(fColCount) do - begin - new(thisColType); - DeclaredColType := Sqlite3_ColumnDeclType(stmt, i); - if DeclaredColType = nil then - thisColType^ := Sqlite3_ColumnType(stmt, i) //use the actual column type instead - //seems to be needed for last_insert_rowid - else - if (DeclaredColType = 'INTEGER') or (DeclaredColType = 'BOOLEAN') then - thisColType^ := dtInt - else - if (DeclaredColType = 'NUMERIC') or - (DeclaredColType = 'FLOAT') or - (DeclaredColType = 'DOUBLE') or - (DeclaredColType = 'REAL') then - thisColType^ := dtNumeric - else - if DeclaredColType = 'BLOB' then - thisColType^ := dtBlob - else - thisColType^ := dtStr; - fColTypes.Add(thiscoltype); - end; - fResults := TList.Create; - end; - - //get column values - for i := 0 to Pred(ColCount) do - begin - ActualColType := Sqlite3_ColumnType(stmt, i); - if (ActualColType = SQLITE_NULL) then - fResults.Add(nil) - else - if pInteger(fColTypes[i])^ = dtInt then - begin - new(thisintvalue); - thisintvalue^ := Sqlite3_ColumnInt64(stmt, i); - fResults.Add(thisintvalue); - end - else - if pInteger(fColTypes[i])^ = dtNumeric then - begin - new(thisdoublevalue); - thisdoublevalue^ := Sqlite3_ColumnDouble(stmt, i); - fResults.Add(thisdoublevalue); - end - else - if pInteger(fColTypes[i])^ = dtBlob then - begin - iNumBytes := Sqlite3_ColumnBytes(stmt, i); - if iNumBytes = 0 then - thisblobvalue := nil - else - begin - thisblobvalue := TMemoryStream.Create; - thisblobvalue.position := 0; - ptr := Sqlite3_ColumnBlob(stmt, i); - thisblobvalue.writebuffer(ptr^, iNumBytes); - end; - fResults.Add(thisblobvalue); - end - else - begin - new(thisstringvalue); - ptrValue := Sqlite3_ColumnText(stmt, i); - setstring(thisstringvalue^, ptrvalue, strlen(ptrvalue)); - fResults.Add(thisstringvalue); - end; - end; - end; - SQLITE_BUSY: - raise ESqliteException.CreateFmt('Could not prepare SQL statement', - [SQL, 'SQLite is Busy']); - else - begin - SQLite3_reset(stmt); - DB.RaiseError('Could not retrieve data', SQL); - end; - end; - iStepResult := Sqlite3_step(Stmt); - end; - fRow := 0; - finally - if Assigned(Stmt) then - Sqlite3_Finalize(stmt); - end; -end; - -//.............................................................................. - -destructor TSQLiteTable.Destroy; -var - i: cardinal; - iColNo: integer; -begin - if Assigned(fResults) then - begin - for i := 0 to fResults.Count - 1 do - begin - //check for blob type - iColNo := (i mod fColCount); - case pInteger(self.fColTypes[iColNo])^ of - dtBlob: - TMemoryStream(fResults[i]).Free; - dtStr: - if fResults[i] <> nil then - begin - setstring(ansiString(fResults[i]^), nil, 0); - dispose(fResults[i]); - end; - else - dispose(fResults[i]); - end; - end; - fResults.Free; - end; - if Assigned(fCols) then - fCols.Free; - if Assigned(fColTypes) then - for i := 0 to fColTypes.Count - 1 do - dispose(fColTypes[i]); - fColTypes.Free; - inherited; -end; - -//.............................................................................. - -function TSQLiteTable.GetColumns(I: integer): ansiString; -begin - Result := fCols[I]; -end; - -//.............................................................................. - -function TSQLiteTable.GetCountResult: integer; -begin - if not EOF then - Result := StrToInt(Fields[0]) - else - Result := 0; -end; - -function TSQLiteTable.GetCount: integer; -begin - Result := FRowCount; -end; - -//.............................................................................. - -function TSQLiteTable.GetEOF: boolean; -begin - Result := fRow >= fRowCount; -end; - -function TSQLiteTable.GetBOF: boolean; -begin - Result := fRow <= 0; -end; - -//.............................................................................. - -function TSQLiteTable.GetFieldByName(FieldName: ansiString): ansiString; -begin - Result := GetFields(self.GetFieldIndex(FieldName)); -end; - -function TSQLiteTable.GetFieldIndex(FieldName: ansiString): integer; -begin - if (fCols = nil) then - begin - raise ESqliteException.Create('Field ' + fieldname + ' Not found. Empty dataset'); - exit; - end; - - if (fCols.count = 0) then - begin - raise ESqliteException.Create('Field ' + fieldname + ' Not found. Empty dataset'); - exit; - end; - - Result := fCols.IndexOf(AnsiUpperCase(FieldName)); - - if (result < 0) then - begin - raise ESqliteException.Create('Field not found in dataset: ' + fieldname) - end; -end; - -//.............................................................................. - -function TSQLiteTable.GetFields(I: cardinal): ansiString; -var - thisvalue: pstring; - thistype: integer; -begin - Result := ''; - if EOF then - raise ESqliteException.Create('Table is at End of File'); - //integer types are not stored in the resultset - //as strings, so they should be retrieved using the type-specific - //methods - thistype := pInteger(self.fColTypes[I])^; - - case thistype of - dtStr: - begin - thisvalue := self.fResults[(self.frow * self.fColCount) + I]; - if (thisvalue <> nil) then - Result := thisvalue^ - else - Result := ''; - end; - dtInt: - Result := IntToStr(self.FieldAsInteger(I)); - dtNumeric: - Result := FloatToStr(self.FieldAsDouble(I)); - dtBlob: - Result := self.FieldAsBlobText(I); - else - Result := ''; - end; -end; - -function TSqliteTable.FieldAsBlob(I: cardinal): TMemoryStream; -begin - if EOF then - raise ESqliteException.Create('Table is at End of File'); - if (self.fResults[(self.frow * self.fColCount) + I] = nil) then - Result := nil - else - if pInteger(self.fColTypes[I])^ = dtBlob then - Result := TMemoryStream(self.fResults[(self.frow * self.fColCount) + I]) - else - raise ESqliteException.Create('Not a Blob field'); -end; - -function TSqliteTable.FieldAsBlobText(I: cardinal): ansiString; -var - MemStream: TMemoryStream; - Buffer: PAnsiChar; -begin - Result := ''; - MemStream := self.FieldAsBlob(I); - if MemStream <> nil then - if MemStream.Size > 0 then - begin - MemStream.position := 0; - {$IFDEF UNICODE} - Buffer := AnsiStralloc(MemStream.Size + 1); - {$ELSE} - Buffer := Stralloc(MemStream.Size + 1); - {$ENDIF} - MemStream.readbuffer(Buffer[0], MemStream.Size); - (Buffer + MemStream.Size)^ := chr(0); - SetString(Result, Buffer, MemStream.size); - strdispose(Buffer); - end; - //do not free the TMemoryStream here; it is freed when - //TSqliteTable is destroyed - -end; - - -function TSqliteTable.FieldAsInteger(I: cardinal): int64; -begin - if EOF then - raise ESqliteException.Create('Table is at End of File'); - if (self.fResults[(self.frow * self.fColCount) + I] = nil) then - Result := 0 - else - if pInteger(self.fColTypes[I])^ = dtInt then - Result := pInt64(self.fResults[(self.frow * self.fColCount) + I])^ - else - if pInteger(self.fColTypes[I])^ = dtNumeric then - Result := trunc(strtofloat(pString(self.fResults[(self.frow * self.fColCount) + I])^)) - else - raise ESqliteException.Create('Not an integer or numeric field'); -end; - -function TSqliteTable.FieldAsDouble(I: cardinal): double; -begin - if EOF then - raise ESqliteException.Create('Table is at End of File'); - if (self.fResults[(self.frow * self.fColCount) + I] = nil) then - Result := 0 - else - if pInteger(self.fColTypes[I])^ = dtInt then - Result := pInt64(self.fResults[(self.frow * self.fColCount) + I])^ - else - if pInteger(self.fColTypes[I])^ = dtNumeric then - Result := pDouble(self.fResults[(self.frow * self.fColCount) + I])^ - else - raise ESqliteException.Create('Not an integer or numeric field'); -end; - -function TSqliteTable.FieldAsString(I: cardinal): ansiString; -begin - if EOF then - raise ESqliteException.Create('Table is at End of File'); - if (self.fResults[(self.frow * self.fColCount) + I] = nil) then - Result := '' - else - Result := self.GetFields(I); -end; - -function TSqliteTable.FieldIsNull(I: cardinal): boolean; -var - thisvalue: pointer; -begin - if EOF then - raise ESqliteException.Create('Table is at End of File'); - thisvalue := self.fResults[(self.frow * self.fColCount) + I]; - Result := (thisvalue = nil); -end; - -//.............................................................................. - -function TSQLiteTable.Next: boolean; -begin - Result := False; - if not EOF then - begin - Inc(fRow); - Result := True; - end; -end; - -function TSQLiteTable.Previous: boolean; -begin - Result := False; - if not BOF then - begin - Dec(fRow); - Result := True; - end; -end; - -function TSQLiteTable.MoveFirst: boolean; -begin - Result := False; - if self.fRowCount > 0 then - begin - fRow := 0; - Result := True; - end; -end; - -function TSQLiteTable.MoveLast: boolean; -begin - Result := False; - if self.fRowCount > 0 then - begin - fRow := fRowCount - 1; - Result := True; - end; -end; - -{$WARNINGS OFF} -function TSQLiteTable.MoveTo(position: cardinal): boolean; -begin - Result := False; - if (self.fRowCount > 0) and (self.fRowCount > position) then - begin - fRow := position; - Result := True; - end; -end; -{$WARNINGS ON} - - - -{ TSQLiteUniTable } - -constructor TSQLiteUniTable.Create(DB: TSQLiteDatabase; const SQL: Ansistring); -begin - Create(DB, SQL, []); -end; - -constructor TSQLiteUniTable.Create(DB: TSQLiteDatabase; const SQL: Ansistring; const Bindings: array of const); -var - NextSQLStatement: PAnsiChar; - i: integer; -begin - inherited create; - self.fDB := db; - self.fEOF := false; - self.fRow := 0; - self.fColCount := 0; - self.fSQL := SQL; - if Sqlite3_Prepare_v2(DB.fDB, PAnsiChar(SQL), -1, fStmt, NextSQLStatement) <> SQLITE_OK then - DB.RaiseError('Error executing SQL', SQL); - if (fStmt = nil) then - DB.RaiseError('Could not prepare SQL statement', SQL); - DB.DoQuery(SQL); - DB.SetParams(fStmt); - DB.BindData(fStmt, Bindings); - - //get data types - fCols := TStringList.Create; - fColCount := SQLite3_ColumnCount(fstmt); - for i := 0 to Pred(fColCount) do - fCols.Add(AnsiUpperCase(Sqlite3_ColumnName(fstmt, i))); - - Next; -end; - -destructor TSQLiteUniTable.Destroy; -begin - if Assigned(fStmt) then - Sqlite3_Finalize(fstmt); - if Assigned(fCols) then - fCols.Free; - inherited; -end; - -function TSQLiteUniTable.FieldAsBlob(I: cardinal): TMemoryStream; -var - iNumBytes: integer; - ptr: pointer; -begin - Result := TMemoryStream.Create; - iNumBytes := Sqlite3_ColumnBytes(fstmt, i); - if iNumBytes > 0 then - begin - ptr := Sqlite3_ColumnBlob(fstmt, i); - Result.writebuffer(ptr^, iNumBytes); - Result.Position := 0; - end; -end; - -function TSQLiteUniTable.FieldAsBlobPtr(I: cardinal; out iNumBytes: integer): Pointer; -begin - iNumBytes := Sqlite3_ColumnBytes(fstmt, i); - Result := Sqlite3_ColumnBlob(fstmt, i); -end; - -function TSQLiteUniTable.FieldAsBlobText(I: cardinal): ansiString; -var - MemStream: TMemoryStream; - Buffer: PAnsiChar; -begin - Result := ''; - MemStream := self.FieldAsBlob(I); - if MemStream <> nil then - try - if MemStream.Size > 0 then - begin - MemStream.position := 0; - {$IFDEF UNICODE} - Buffer := AnsiStralloc(MemStream.Size + 1); - {$ELSE} - Buffer := Stralloc(MemStream.Size + 1); - {$ENDIF} - MemStream.readbuffer(Buffer[0], MemStream.Size); - (Buffer + MemStream.Size)^ := chr(0); - SetString(Result, Buffer, MemStream.size); - strdispose(Buffer); - end; - finally - MemStream.Free; - end -end; - -function TSQLiteUniTable.FieldAsDouble(I: cardinal): double; -begin - Result := Sqlite3_ColumnDouble(fstmt, i); -end; - -function TSQLiteUniTable.FieldAsInteger(I: cardinal): int64; -begin - Result := Sqlite3_ColumnInt64(fstmt, i); -end; - -function TSQLiteUniTable.FieldAsString(I: cardinal): ansiString; -begin - Result := self.GetFields(I); -end; - -function TSQLiteUniTable.FieldIsNull(I: cardinal): boolean; -begin - Result := Sqlite3_ColumnText(fstmt, i) = nil; -end; - -function TSQLiteUniTable.GetColumns(I: integer): ansiString; -begin - Result := fCols[I]; -end; - -function TSQLiteUniTable.GetFieldByName(FieldName: ansiString): ansiString; -begin - Result := GetFields(self.GetFieldIndex(FieldName)); -end; - -function TSQLiteUniTable.GetFieldIndex(FieldName: ansiString): integer; -begin - if (fCols = nil) then - begin - raise ESqliteException.Create('Field ' + fieldname + ' Not found. Empty dataset'); - exit; - end; - - if (fCols.count = 0) then - begin - raise ESqliteException.Create('Field ' + fieldname + ' Not found. Empty dataset'); - exit; - end; - - Result := fCols.IndexOf(AnsiUpperCase(FieldName)); - - if (result < 0) then - begin - raise ESqliteException.Create('Field not found in dataset: ' + fieldname) - end; -end; - -function TSQLiteUniTable.GetFields(I: cardinal): ansiString; -begin - Result := Sqlite3_ColumnText(fstmt, i); -end; - -function TSQLiteUniTable.Next: boolean; -var - iStepResult: integer; -begin - fEOF := true; - iStepResult := Sqlite3_step(fStmt); - case iStepResult of - SQLITE_ROW: - begin - fEOF := false; - inc(fRow); - end; - SQLITE_DONE: - // we are on the end of dataset - // return EOF=true only - ; - else - begin - SQLite3_reset(fStmt); - fDB.RaiseError('Could not retrieve data', fSQL); - end; - end; - Result := not fEOF; -end; - -end. - diff --git a/sqlite/sqlite3udf.pas b/sqlite/sqlite3udf.pas deleted file mode 100644 index 90d4544..0000000 --- a/sqlite/sqlite3udf.pas +++ /dev/null @@ -1,131 +0,0 @@ -{ -UDF Sqlite3 support v1.0.0 - translation to Pascal by Lukas Gebauer - -This is experimental translation. Be patient! -} -unit sqlite3udf; - -interface - -uses - sqlite3; - -type - Psqlite3_context = pointer; - Psqlite3_value = ppchar; - - TxFunc = procedure(sqlite3_context: Psqlite3_context; cArg: integer; ArgV: Psqlite3_value); - TxStep = procedure(sqlite3_context: Psqlite3_context; cArg: integer; ArgV: Psqlite3_value); - TxFinal = procedure(sqlite3_context: Psqlite3_context); -{ - void (*xFunc)(sqlite3_context*,int,sqlite3_value**), - void (*xStep)(sqlite3_context*,int,sqlite3_value**), - void (*xFinal)(sqlite3_context*) -} - -//UDF SQLITE3 support -function sqlite3_create_function(db: TSQLiteDB; functionName: PChar; nArg: integer; - eTextRep: integer; pUserdata: pointer; xFunc: TxFunc; xStep: TxStep; xFinal: TxFinal - ): integer; cdecl; external SQLiteDLL name 'sqlite3_create_function'; - -procedure sqlite3_result_blob(sqlite3_context: Psqlite3_context; value: Pointer; - n: integer; destroy: pointer); cdecl; external SQLiteDLL name 'sqlite3_result_blob'; -procedure sqlite3_result_double(sqlite3_context: Psqlite3_context; value: Double); - cdecl; external SQLiteDLL name 'sqlite3_result_double'; -procedure sqlite3_result_error(sqlite3_context: Psqlite3_context; value: Pchar; - n: integer); cdecl; external SQLiteDLL name 'sqlite3_result_error'; -procedure sqlite3_result_error16(sqlite3_context: Psqlite3_context; value: PWidechar; - n: integer); cdecl; external SQLiteDLL name 'sqlite3_result_error16'; -procedure sqlite3_result_int(sqlite3_context: Psqlite3_context; value: integer); - cdecl; external SQLiteDLL name 'sqlite3_result_int'; -procedure sqlite3_result_int64(sqlite3_context: Psqlite3_context; value: int64); - cdecl; external SQLiteDLL name 'sqlite3_result_int64'; -procedure sqlite3_result_null(sqlite3_context: Psqlite3_context); - cdecl; external SQLiteDLL name 'sqlite3_result_null'; -procedure sqlite3_result_text(sqlite3_context: Psqlite3_context; value: PChar; - n: integer; destroy: pointer); cdecl; external SQLiteDLL name 'sqlite3_result_text'; -procedure sqlite3_result_text16(sqlite3_context: Psqlite3_context; value: PWideChar; - n: integer; destroy: pointer); cdecl; external SQLiteDLL name 'sqlite3_result_text16'; -procedure sqlite3_result_text16be(sqlite3_context: Psqlite3_context; value: PWideChar; - n: integer; destroy: pointer); cdecl; external SQLiteDLL name 'sqlite3_result_text16be'; -procedure sqlite3_result_text16le(sqlite3_context: Psqlite3_context; value: PWideChar; - n: integer; destroy: pointer); cdecl; external SQLiteDLL name 'sqlite3_result_text16le'; -procedure sqlite3_result_value(sqlite3_context: Psqlite3_context; value: Psqlite3_value); - cdecl; external SQLiteDLL name 'sqlite3_result_value'; - -{ - void sqlite3_result_blob(sqlite3_context*, const void*, int n, void(*)(void*)); - void sqlite3_result_double(sqlite3_context*, double); - void sqlite3_result_error(sqlite3_context*, const char*, int); - void sqlite3_result_error16(sqlite3_context*, const void*, int); - void sqlite3_result_int(sqlite3_context*, int); - void sqlite3_result_int64(sqlite3_context*, long long int); - void sqlite3_result_null(sqlite3_context*); - void sqlite3_result_text(sqlite3_context*, const char*, int n, void(*)(void*)); - void sqlite3_result_text16(sqlite3_context*, const void*, int n, void(*)(void*)); - void sqlite3_result_text16be(sqlite3_context*, const void*, int n, void(*)(void*)); - void sqlite3_result_text16le(sqlite3_context*, const void*, int n, void(*)(void*)); - void sqlite3_result_value(sqlite3_context*, sqlite3_value*); -} - -function sqlite3_value_blob(value: pointer): Pointer; - cdecl; external SQLiteDLL name 'sqlite3_value_blob'; -function sqlite3_value_bytes(value: pointer): integer; - cdecl; external SQLiteDLL name 'sqlite3_value_bytes'; -function sqlite3_value_bytes16(value: pointer): integer; - cdecl; external SQLiteDLL name 'sqlite3_value_bytes16'; -function sqlite3_value_double(value: pointer): double; - cdecl; external SQLiteDLL name 'sqlite3_value_double'; -function sqlite3_value_int(value: pointer): integer; - cdecl; external SQLiteDLL name 'sqlite3_value_int'; -function sqlite3_value_int64(value: pointer): int64; - cdecl; external SQLiteDLL name 'sqlite3_value_int64'; -function sqlite3_value_text(value: pointer): PChar; - cdecl; external SQLiteDLL name 'sqlite3_value_text'; -function sqlite3_value_text16(value: pointer): PWideChar; - cdecl; external SQLiteDLL name 'sqlite3_value_text16'; -function sqlite3_value_text16be(value: pointer): PWideChar; - cdecl; external SQLiteDLL name 'sqlite3_value_text16be'; -function sqlite3_value_text16le(value: pointer): PWideChar; - cdecl; external SQLiteDLL name 'sqlite3_value_text16le'; -function sqlite3_value_type(value: pointer): integer; - cdecl; external SQLiteDLL name 'sqlite3_value_type'; - -{ const void *sqlite3_value_blob(sqlite3_value*); - int sqlite3_value_bytes(sqlite3_value*); - int sqlite3_value_bytes16(sqlite3_value*); - double sqlite3_value_double(sqlite3_value*); - int sqlite3_value_int(sqlite3_value*); - long long int sqlite3_value_int64(sqlite3_value*); - const unsigned char *sqlite3_value_text(sqlite3_value*); - const void *sqlite3_value_text16(sqlite3_value*); - const void *sqlite3_value_text16be(sqlite3_value*); - const void *sqlite3_value_text16le(sqlite3_value*); - int sqlite3_value_type(sqlite3_value*); -} - -{ -//Sample of usage: -PROCEDURE fn(ctx:pointer;n:integer;args:ppchar);cdecl; -VAR p : ppchar; theString : string; res:integer; -BEGIN -p := args; -theString := trim(sqlite3_value_text(p^)); - -...do something with theString... - -sqlite3_result_int(ctx,res); // < return a number based on string -END; -... -var i:integer; -begin -i := sqlite3_create_function(db3,'myfn',1,SQLITE_UTF8,nil,@fn,nil,nil); -s := 'select myfn(thestring) from theTable;' -...execute statement... -end; -} - -implementation - -end.