Select a directed SubGraph without sinks and sources

Let's denote the graph by gr and the initial subset of vertices by v.

Connecting the graph

First, we break the subgraph generated by v into connected components. We select one vertex from the smallest connected component, and another one that is not in it. We find the shortest path in the undirected gr that connects these two, and add all vertices from the shortest path to v. Repeat until the subgraph becomes connected.

smallestComponent[g_Graph] := 
 With[{components = ConnectedComponents@UndirectedGraph[g]},
  Extract[components, Ordering[components, 1]]
 ]

connectStep[gr_, v_] :=
 Module[{sc, rest},
  sc = smallestComponent@Subgraph[gr, v];
  rest = Complement[v, sc];
  If[rest === {},
   v,
   Union[
    FindShortestPath[UndirectedGraph[gr], First[sc], First[rest]],
    v
    ]
   ]
  ]

connect[gr_, v_] := FixedPoint[connectStep[gr, #] &, v]

Usage:

connect[gr, {"1", "3", "7"}]

(* ==> {"1", "3", "7", "9"} *)

Getting rid of sinks and sources

Let's assume that the subgraph is connected.

Take the subgraph, and select one sink from v. Then select any other vertex and find the shortest path between these two in the directed gr, using the sink as starting point. Add all vertices from the shortest path to v. Repeat until there are no sinks in the subgraph.

Sources can be removed in an analogous way, except they need to be end point of the path.

sinks[g_?GraphQ] := Pick[VertexList[g], VertexOutDegree[g], 0]
sources[g_?GraphQ] := Pick[VertexList[g], VertexInDegree[g], 0]

step[sinkOrSource_][gr_, v_] :=
 Module[{ss, s, t},
  ss = sinkOrSource[Subgraph[gr, v]];
  If[ss === {},
   v,

   s = First[ss];
   t = First@DeleteCases[v, s];
   If[sinkOrSource == source, {s,t} = {t,s}];
   Union[v, FindShortestPath[gr, s, t]]
   ]
  ]

FixedPoint[step[sink][gr, #]&, {"1", "3"}]

(* ==> {"1", "3", "9"} *)

Most of the work can be done much simpler than Szabolcs' answer.

1: Identify and get rid of sinks/sources and useless vertices in a single step

You can weed out all sinks/sources and vertices that will only lead to sinks/sources easily as follows:

{deadVtx, possibleVtx} = GatherBy[ConnectedComponents[gr], Length[#]==1 &];

You can see for yourself that any vertex in deadVtx will not lead you anywhere:

2: Use ConnectedGraphQ to check for connectivity

Given an initial vertex list initVtx, you can:

1. use the above two vertex lists and MemberQ to check if the initial list contains any vertex from the deadVtx list and issue an error and stop if it does.

2. check if it is already connected with

   ConnectedGraphQ[Subgraph[gr, initVtx]]
   

3. add vertices only from the possibleVtx list if it is not already connected.

3: Get components that are immediately connected using VertexComponent:

If it is not already connected, instead of adding an arbitrary, possibly distant vertex, you can pick one that is only 1 connection away from the existing vertices with:

Complement[VertexComponent[sgr, initVtx, 1], initVtx]

---

I think the above can be worked into your vertex folding routine, and so I'm not doing that part.

We can use GraphComputation`SourceVertexList and GraphComputation`SinkVertexList to get the source and sink vertices and VertexDelete them using the function:

vdF = VertexDelete[#, Union[GraphComputation`SinkVertexList[#], 
     GraphComputation`SourceVertexList[#]]] &;

A FixedPoint of the function vdF will have no source or sink vertices.

Examples:

Row[{g1 = RandomGraph[{15, 20}, DirectedEdges -> True, 
    VertexLabels -> "Name", ImagePadding -> 20, ImageSize -> 300], 
  fp = FixedPoint[vdF, g1], HighlightGraph[g1, EdgeList[fp]]}]

ex = {"9" -> "7", "4" -> "6", "1" -> "9", "3" -> "5", "10" -> "8", 
 "5" -> "2", "2" -> "5", "9" -> "3", "3" -> "1", "7" -> "9", 
 "8" -> "6", "3" -> "10", "2" -> "1", "7" -> "4", "1" -> "4", 
 "2" -> "7", "5" -> "6", "7" -> "2"};

gr = Graph[ex, VertexLabels -> "Name", ImagePadding -> 20, ImageSize -> 300];
Row[{gr, fp = FixedPoint[vdF, gr], HighlightGraph[gr, EdgeList[fp]]}]

vertices = {30, 43, 57, 1, 75, 24, 74, 94, 62, 47, 51, 89, 95, 87, 5, 
   73, 80, 91, 3, 67, 4, 8, 93, 18, 85, 49, 39, 13, 45, 79, 96, 98, 
   81, 19, 21, 15, 10, 60, 77, 76};
edges = {85 -> 4, 94 -> 95, 45 -> 18, 75 -> 3, 80 -> 30, 15 -> 80, 
   51 -> 21, 15 -> 43, 13 -> 95, 75 -> 91, 4 -> 30, 95 -> 76, 
   94 -> 51, 95 -> 21, 30 -> 45, 81 -> 96, 39 -> 13, 89 -> 1, 76 -> 3,
    96 -> 47, 67 -> 77, 67 -> 10, 4 -> 24, 57 -> 89, 73 -> 95, 
   89 -> 51, 45 -> 80, 21 -> 8, 74 -> 73, 98 -> 96, 4 -> 76, 77 -> 79,
    43 -> 93, 15 -> 19, 3 -> 57, 76 -> 15, 94 -> 24, 45 -> 15, 
   75 -> 89, 73 -> 60, 3 -> 49, 98 -> 10, 1 -> 43, 10 -> 15, 49 -> 5, 
   8 -> 79, 51 -> 10, 60 -> 51, 3 -> 13, 60 -> 43, 96 -> 62, 57 -> 4, 
   45 -> 95, 67 -> 5, 1 -> 4, 98 -> 30, 39 -> 75, 39 -> 18, 89 -> 75, 
   89 -> 15, 43 -> 39, 60 -> 10, 91 -> 39, 85 -> 8, 47 -> 89, 
   57 -> 85, 76 -> 39, 98 -> 95, 51 -> 73, 76 -> 8, 30 -> 49, 
   87 -> 49, 77 -> 93, 80 -> 21, 96 -> 57, 39 -> 76, 39 -> 30, 
   62 -> 91, 94 -> 10, 96 -> 81, 95 -> 75, 62 -> 77, 3 -> 87, 
   43 -> 87, 49 -> 24, 21 -> 87, 94 -> 39, 94 -> 98, 87 -> 89, 
   5 -> 13, 21 -> 67, 47 -> 5, 62 -> 47, 39 -> 47, 91 -> 60, 96 -> 76,
    10 -> 79};

gr2 = Graph[vertices, edges, VertexLabels -> "Name", ImagePadding -> 20, ImageSize->300];
Row[{gr2, fp = FixedPoint[vdF, gr2], HighlightGraph[gr2, EdgeList[fp]]}]