udb.pas

著名的SecureBlackBox控件完整源码

      GetPacks(SL);
      for I := 0 to SL.Count - 1 do
        if CompareText(packname, _GetValueFromIndex(SL,I))=0 then begin
          Result := True;
          Break;
        end;
    finally
      SL.Free;
    end;
  finally
    RW.LeaveRead;
  end;
end;

function SetPackVisibility(pack_id, vis_level : string) : boolean;
begin
  RW.EnterWrite;
  try
    DB.WriteString(T_PACKS_VISIBILITY, pack_id, vis_level);
    DB.UpdateFile;
  finally
    RW.LeaveWrite;
  end;
  Result := True;
end;

function GetPackVisibility(pack_id : string) : string;
begin
  Result := DEFAULT_PACK_VISIBILITY_LEVEL;
  RW.EnterRead;
  try
    Result := DB.ReadString(T_PACKS_VISIBILITY, pack_id, DEFAULT_PACK_VISIBILITY_LEVEL);
  finally
    RW.LeaveRead;
  end;
end;

function AddFile(pack_id, fname, description, size, datetime : string; var id : string) : boolean;
var
  SL : TStringList;
  sec_pack_files : string;

  function __GetIDbyName (fname : string) : string;
  var
    Files : TStringList;
    I : integer;
    subs : string;
  begin
    Files := TStringList.Create;
    try
      DB.ReadSectionValues(T_FILES, Files);
      subs := Format('fname=%s', [fname]);
      for I := 0 to Files.Count - 1 do
        if Pos(subs, Files[I]) > 0 then begin
          Result := Files.Names[I];
          Break;
        end;
    finally
      Files.Free;
    end;
  end;
  
begin
  RW.EnterWrite;
  try
    if DB.ValueExists(T_PACKS, pack_id) then
      begin
        sec_pack_files := Format(T_PACKS_FILES, [pack_id]);
        SL := TStringList.Create;
        try
          if id = '' then begin
            id := __GetIDbyName(fname);
            if id = '' then
              id := GetNextID(T_FILES);
          end;

          SL.Clear;
          SL.CommaText := DB.ReadString(T_FILES, id, '');
          SL.Values['fname'] := fname;
          SL.Values['desc'] := description;
          SL.Values['date'] := datetime;
          SL.Values['size'] := size;

          if not DB.ValueExists(sec_pack_files, id) then begin
            SL.Values['count'] := IntToStr(StrToIntDef(SL.Values['count'], 0) + 1);
            DB.WriteString(sec_pack_files, id, '');
          end;
          
          DB.WriteString(T_FILES, id, SL.CommaText);
          DB.UpdateFile;
          Result := True;
        finally
          SL.Free;
        end;
      end
    else
      Result := False;
  finally
    RW.LeaveWrite
  end;
end;

function GetFileInfo(pack_id, file_id : string; var fname, description, filedatetime, size : string) : boolean;
var
  SL : TStringList;
  sec_pack_files : string;
begin
  RW.EnterRead;
  try
    sec_pack_files := format(T_PACKS_FILES, [pack_id]);
    Result := DB.ValueExists(sec_pack_files, file_id);
    if Result then
      begin
        SL := TStringList.Create;
        try
          SL.CommaText := DB.ReadString(T_FILES, file_id, '');
          fname := SL.Values['fname'];
          description := SL.Values['desc'];
          filedatetime := SL.Values['date'];
          size := SL.Values['size'];
        finally
          SL.Free;
        end;
      end
    else
      begin
        fname := '';
        description := '';
        filedatetime := '';
        size := '';
      end;
  finally
    RW.LeaveRead
  end;
end;

function IsFileExists(fname : string; var packname : string) : boolean;
var
  Packs : TStringList;
  pack_id : string;
  I : integer;
begin
  Result := False;
  Packs := TStringList.Create;
  try
    GetPacks(Packs);
    for I := 0 to Packs.Count - 1 do begin
      pack_id := Packs.Names[I];
      if IsFileInPackExists(pack_id, fname) then begin
        packname := _GetValueFromIndex(Packs,I);
        Result := true;
        Break;
      end;
    end;
  finally
    Packs.Free;
  end;
end;

function IsFileInPackExists(pack_id, fname : string) : boolean;
var
  Files : TStringList;
  SL : TStringList;
  I : integer;
begin
  Result := False;

  RW.EnterRead;
  try
    Files := TStringList.Create;
    try
      GetFiles(pack_id, Files);
      if Files.Count = 0 then
        Exit;

      SL := TStringList.Create;
      try
        for I := 0 to Files.Count - 1 do begin
          SL.CommaText := _GetValueFromIndex(Files,I);
          if CompareText(fname, SL.Values['fname'])=0 then begin
            Result := True;
            Break;
          end;
        end;
      finally
        SL.Free;
      end;
    finally
      Files.Free;
    end;
  finally
    RW.LeaveRead;
  end;
end;

procedure GetFiles(pack_id : string; Files : TStrings);
var
  I : integer;
  file_id : string;
begin
  RW.EnterRead;
  try
    DB.ReadSectionValues(Format(T_PACKS_FILES, [pack_id]), Files);
    for I := 0 to Files.Count - 1 do begin
      file_id := Files.Names[I];
      Files[I] := Format('%s=%s', [file_id, DB.ReadString(T_FILES, file_id, '')]);
    end;
  finally
    RW.LeaveRead
  end;
end;

procedure GetFilesTiny(pack_id : string; Files : TStrings);
begin
  RW.EnterRead;
  try
    DB.ReadSectionValues(Format(T_PACKS_FILES, [pack_id]), Files);
  finally
    RW.LeaveRead
  end;
end;

procedure GetFilesAll(Files : TStrings); 
begin
  RW.EnterRead;
  try
    DB.ReadSectionValues(T_FILES, Files);
  finally
    RW.LeaveRead
  end;
end;

function SaveFileDesc(file_id, description : string) : boolean;
var
  SL : TStringList;
begin
  RW.EnterWrite;
  try
    if DB.ValueExists(T_FILES, file_id) then
      begin
        SL := TStringList.Create;
        try
          SL.CommaText := DB.ReadString(T_FILES, file_id, '');
          SL.Values['desc'] := description;
          DB.WriteString(T_FILES, file_id, SL.CommaText);
          DB.UpdateFile;
          Result := True;
        finally
          SL.Free;
        end;
      end
    else
      Result := False;
  finally
    RW.LeaveWrite;
  end;
end;

function BindFile(pack_id, file_id : string) : boolean;
var
  SL : TStringList;
  sec_pack_files : string;
begin
  RW.EnterWrite;
  try
    if DB.ValueExists(T_PACKS, pack_id) then
      begin
        sec_pack_files := Format(T_PACKS_FILES, [pack_id]);
        SL := TStringList.Create;
        try
          SL.CommaText := DB.ReadString(T_FILES, file_id, '');
          SL.Values['count'] := IntToStr(StrToIntDef(SL.Values['count'], 0) + 1);
          DB.WriteString(sec_pack_files, file_id, '');
          DB.WriteString(T_FILES, file_id, SL.CommaText);
          DB.UpdateFile;
          Result := True;
        finally
          SL.Free;
        end;
      end
    else
      Result := False;
  finally
    RW.LeaveWrite
  end;
end;

function DelFile(pack_id, file_id : string) : boolean;
var
  SL : TStringList;
  cnt : integer;
begin
  Result := False;

  RW.EnterWrite;
  try
    if DB.ValueExists(T_PACKS, pack_id) then begin
      DB.DeleteKey(Format(T_PACKS_FILES, [pack_id]), file_id);
      SL := TStringList.Create;
      try
        SL.CommaText := DB.ReadString(T_FILES, file_id, '');
        cnt := StrToIntDef(SL.Values['count'], 0) - 1;
        SL.Values['count'] := IntToStr(cnt);
        if cnt <= 0 then
          begin
            DB.DeleteKey(T_FILES, file_id);
            Result := True;
          end
        else
          DB.WriteString(T_FILES, file_id, SL.CommaText);
      finally
        SL.Free;
      end;
      DB.UpdateFile;
    end;
  finally
    RW.LeaveWrite
  end;
end;

function GetGrant(login, pack_id : string; var expiredate : string) : boolean;
begin
  RW.EnterRead;
  try
    expiredate := '';
    Result := CompareText(GetPackVisibility(pack_id), 'public')=0;
    if Result then
      Exit
    else
      Result := DB.ValueExists(format(T_USERS_GRANTS, [login]), pack_id);
      
    if Result then
      begin
        expiredate := DB.ReadString(format(T_USERS_GRANTS, [login]), pack_id, '');
      end
    else
      begin
        expiredate := '';
      end;
  finally
    RW.LeaveRead
  end;
end;

function SaveUserAccess(login, pack_id : string; grant: boolean; expiredate : string) : boolean;
begin
  RW.EnterWrite;
  try
    if grant then
      DB.WriteString(format(T_USERS_GRANTS, [login]), pack_id, expiredate)
    else
      DB.DeleteKey(format(T_USERS_GRANTS, [login]), pack_id);
    DB.UpdateFile;
    Result := True;
  finally
    RW.LeaveWrite
  end;
end;

function IsFileAvailableForUser(login, filename : string) : boolean;
var
  Packs : TStringList;
  grant : boolean;
  s_expiredate : string;
  d_expiredate : TDateTime;
  I : integer;
  pack_id : string;
begin
  Result := False;
  Packs := TStringList.Create;
  GetPacks(Packs);
  if Packs.Count > 0 then begin
    for I := 0 to Packs.Count - 1 do begin
      pack_id := Packs.Names[I];
      grant := GetGrant(login, pack_id, s_expiredate);
      if grant then begin
        if Trim(s_expiredate) <> '' then
          d_expiredate := Str2DateTime(s_expiredate)
        else
          d_expiredate := Now;

        if Trunc(d_expiredate) >= Trunc(Now) then begin
          Result := IsFileInPackExists(pack_id, filename);
          if Result then
            Break;
        end;
      end;
    end;
  end;
  Packs.Free;
end;

initialization
  RW:=TRtcRWSec.Create;;

finalization;
  if assigned(DB) then Garbage(DB);
  Garbage(RW);
end.